Extract specifc pages from word document

YasserKhalil
PlatinumLounger
Posts: 4936
Joined: 31 Aug 2016, 09:02

Extract specifc pages from word document

Post by YasserKhalil »

Hello everyone
I have file named `Source.doc` and I need to extract the pages from page 1 to page 6 only and save it as new word document but with the extension docx

User avatar
HansV
Administrator
Posts: 78783
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Extract specifc pages from word document

Post by HansV »

Do you want to do this in Word? Or from Excel?
Best wishes,
Hans

YasserKhalil
PlatinumLounger
Posts: 4936
Joined: 31 Aug 2016, 09:02

Re: Extract specifc pages from word document

Post by YasserKhalil »

I am working from excel.

User avatar
HansV
Administrator
Posts: 78783
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Extract specifc pages from word document

Post by HansV »

Code: Select all

Sub Test()
    Dim objWrd As Object
    Dim objDoc As Object
    Dim f As Boolean

    On Error Resume Next
    Set objWrd = GetObject(Class:="Word.Application")
    On Error GoTo ErrHandler
    If objWrd Is Nothing Then
        Set objWrd = CreateObject(Class:="Word.Application")
        f = True
    End If

    ' Modify the path
    Set objDoc = objWrd.Documents.Open(Filename:="C:\Word\Source.doc")
    With objDoc
        .Range(Start:=.Goto(What:=1, Which:=1, Count:=7).Start, End:=.Range.End).Delete
        .SaveAs2 Filename:=Replace(.FullName, ".doc", ".docx"), FileFormat:=12
    End With

ExitHandler:
    On Error Resume Next
    objDoc.Close SaveChanges:=False
    If f Then
        objWrd.Quit SaveChanges:=False
    End If
    Exit Sub

ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub
Best wishes,
Hans

YasserKhalil
PlatinumLounger
Posts: 4936
Joined: 31 Aug 2016, 09:02

Re: Extract specifc pages from word document

Post by YasserKhalil »

Thank you very much. How to save the new file with the name `Output_1_To_6`

User avatar
HansV
Administrator
Posts: 78783
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Extract specifc pages from word document

Post by HansV »

Change the

Filename:=Replace(.FullName, ".doc", ".docx")

part.
Best wishes,
Hans

YasserKhalil
PlatinumLounger
Posts: 4936
Joined: 31 Aug 2016, 09:02

Re: Extract specifc pages from word document

Post by YasserKhalil »

Thanks a lot
I have changed

Code: Select all

    With objDoc
        .Range(Start:=.Goto(What:=1, Which:=iStart, Count:=iEnd + 1).Start, End:=.Range.End).Delete
        .SaveAs2 Filename:=ThisWorkbook.Path & "\Output_" & iStart & "_To_" & iEnd, FileFormat:=12
    End With
But I am confused what this part refers to `What:=1`
Another point, in the word document output I got 7 pages (the 7th one is empty)

User avatar
HansV
Administrator
Posts: 78783
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Extract specifc pages from word document

Post by HansV »

1 = wdGoToPage

Is this better?

Code: Select all

        .Range(Start:=.Goto(What:=1, Which:=iStart, Count:=iEnd + 1).Start - 1, End:=.Range.End).Delete
Best wishes,
Hans

User avatar
HansV
Administrator
Posts: 78783
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Extract specifc pages from word document

Post by HansV »

And you should keep Which:=1 (=wdGoToAbsolute)
Best wishes,
Hans

YasserKhalil
PlatinumLounger
Posts: 4936
Joined: 31 Aug 2016, 09:02

Re: Extract specifc pages from word document

Post by YasserKhalil »

Thank you very much. That is better now.
I tried to change the start and end `Const iStart As Long = 3, iEnd As Long = 6` but got an error `Value out of range`

User avatar
HansV
Administrator
Posts: 78783
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Extract specifc pages from word document

Post by HansV »

What are you trying to do now?
Best wishes,
Hans

YasserKhalil
PlatinumLounger
Posts: 4936
Joined: 31 Aug 2016, 09:02

Re: Extract specifc pages from word document

Post by YasserKhalil »

I need to extract specific pages as range from page x to page y and save it to new file

User avatar
HansV
Administrator
Posts: 78783
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Extract specifc pages from word document

Post by HansV »

Try this version:

Code: Select all

Sub Test()
    Extract DocName:="C:\Word\Source.doc", FirstPage:=3, LastPage:=6
End Sub

Sub Extract(DocName As String, FirstPage As Long, LastPage As Long)
    Dim objWrd As Object
    Dim objDoc As Object
    Dim f As Boolean
    Dim FirstPos As Long
    Dim LastPos As Long
    Dim fName As String

    On Error Resume Next
    Set objWrd = GetObject(Class:="Word.Application")
    On Error GoTo ErrHandler
    If objWrd Is Nothing Then
        Set objWrd = CreateObject(Class:="Word.Application")
        f = True
    End If

    Set objDoc = objWrd.Documents.Open(Filename:=DocName)
    With objDoc
        FirstPos = .Goto(What:=1, Which:=1, Count:=FirstPage).Start
        LastPos = .Goto(What:=1, Which:=1, Count:=LastPage + 1).Start - 1
        If LastPos < .Range.End Then
            .Range(Start:=LastPos, End:=.Range.End).Delete
        End If
        If FirstPos > 1 Then
            .Range(Start:=1, End:=FirstPos - 1).Delete
        End If
        fName = ThisWorkbook.Path & "\Output_" & FirstPage & "_To_" & LastPage
        .SaveAs2 Filename:=fName, FileFormat:=12
    End With

ExitHandler:
    On Error Resume Next
    objDoc.Close SaveChanges:=False
    If f Then
        objWrd.Quit SaveChanges:=False
    End If
    Exit Sub

ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub
Best wishes,
Hans

YasserKhalil
PlatinumLounger
Posts: 4936
Joined: 31 Aug 2016, 09:02

Re: Extract specifc pages from word document

Post by YasserKhalil »

Amazing. Thank you very much.
In the output, I have the first page as empty one

User avatar
HansV
Administrator
Posts: 78783
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Extract specifc pages from word document

Post by HansV »

Is this better?

Code: Select all

Sub Test()
    Extract DocName:="C:\Word\Source.doc", FirstPage:=3, LastPage:=6
End Sub

Sub Extract(DocName As String, FirstPage As Long, LastPage As Long)
    Dim objWrd As Object
    Dim objDoc As Object
    Dim f As Boolean
    Dim FirstPos As Long
    Dim LastPos As Long
    Dim fName As String

    On Error Resume Next
    Set objWrd = GetObject(Class:="Word.Application")
    On Error GoTo ErrHandler
    If objWrd Is Nothing Then
        Set objWrd = CreateObject(Class:="Word.Application")
        f = True
    End If

    Set objDoc = objWrd.Documents.Open(Filename:=DocName)
    With objDoc
        FirstPos = .Goto(What:=1, Which:=1, Count:=FirstPage).Start
        LastPos = .Goto(What:=1, Which:=1, Count:=LastPage + 1).Start - 1
        If LastPos < .Range.End Then
            .Range(Start:=LastPos, End:=.Range.End).Delete
        End If
        If FirstPos > 1 Then
            .Range(Start:=1, End:=FirstPos).Delete
        End If
        fName = ThisWorkbook.Path & "\Output_" & FirstPage & "_To_" & LastPage
        .SaveAs2 Filename:=fName, FileFormat:=12
    End With

ExitHandler:
    On Error Resume Next
    objDoc.Close SaveChanges:=False
    If f Then
        objWrd.Quit SaveChanges:=False
    End If
    Exit Sub

ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub
Best wishes,
Hans

YasserKhalil
PlatinumLounger
Posts: 4936
Joined: 31 Aug 2016, 09:02

Re: Extract specifc pages from word document

Post by YasserKhalil »

The same weird problem. The first page in the output is extra page and empty !!

User avatar
HansV
Administrator
Posts: 78783
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Extract specifc pages from word document

Post by HansV »

Could you attach a sample document?
Best wishes,
Hans

YasserKhalil
PlatinumLounger
Posts: 4936
Joined: 31 Aug 2016, 09:02

Re: Extract specifc pages from word document

Post by YasserKhalil »

Here's sample file as the original file is too large
https://www.mediafire.com/file/jjao5xtr ... t.zip/file

User avatar
HansV
Administrator
Posts: 78783
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Extract specifc pages from word document

Post by HansV »

Yasser, this is frustrating. First you ask to extract pages 1 to 6, then any range of pages, and now it turns out that each page is a section, so you actually want to extract sections. If you had told us so at the beginning, the code would have been easier and the problem would have been solved by now.

Code: Select all

Sub Test()
    Extract DocName:="C:\Word\Source.doc", FirstSection:=3, LastSection:=6
End Sub

Sub Extract(DocName As String, FirstSection As Long, LastSection As Long)
    Dim objWrd As Object
    Dim objDoc As Object
    Dim objRng As Object
    Dim f As Boolean
    Dim i As Long
    Dim fName As String

    On Error Resume Next
    Set objWrd = GetObject(Class:="Word.Application")
    On Error GoTo ErrHandler
    If objWrd Is Nothing Then
        Set objWrd = CreateObject(Class:="Word.Application")
        f = True
    End If

    Set objDoc = objWrd.Documents.Open(FileName:=DocName)
    With objDoc
        For i = .Sections.Count To 1 Step -1
            If i < FirstSection Or i > LastSection Then
                .Sections(i).Range.Delete
            End If
        Next i    '
        ' Delete last section break
        Set objRng = .Range
        objRng.Collapse Direction:=0
        objRng.MoveStart Count:=-1
        If Asc(objRng) = 12 Then
            objRng.Delete
        End If
        fName = ThisWorkbook.Path & "\Output_" & FirstPage & "_To_" & LastPage
        .SaveAs2 FileName:=fName, FileFormat:=12
    End With

ExitHandler:
    On Error Resume Next
    objDoc.Close SaveChanges:=False
    If f Then
        objWrd.Quit SaveChanges:=False
    End If
    Exit Sub

ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub
Best wishes,
Hans

YasserKhalil
PlatinumLounger
Posts: 4936
Joined: 31 Aug 2016, 09:02

Re: Extract specifc pages from word document

Post by YasserKhalil »

I am so sorry but I didn't know about sections. I am dealing with word documents as pages
Thank you very much for your great help. Now it is solved completely.