VBA Determine Number of Pages in Word Document

I am devoping an Access 2013 app for a client that uses VBA and mail merge from with the access app to create word documents as output.  There will be many word documents created, one for each selected customer.

Eventually, these documents will be printed and mailed to the customers with the customers being responsible for postage fees.  The size of the documents will vary based on the amount of information being reported to the customer.  I need to determine the number of pages in the created word document so I can calculate the postage charges.

Is there some way to do this using VBA?  I will know the name and location of the created document.

It would be best if I can determine the number of pages as the document is being created.  I include the code I am using below.  Is there somewhere in that code that I could determine the number of pages in the document being created?

Here is an example of code I am using:
Public Sub CreateMailMerge_EE3_wPDF()

'open the mergedoc
        'late binding for version compatibility
        ''Dim oApp As Object
        ''Dim MlMrge As Object
        
        'Word constants (already defined if early binding)
        Const wdDefaultFirstRecord = 1
        Const wdDefaultLastRecord = -16
        Const wdSendToNewDocument = 0
        Const wdDoNotSaveChanges = 0
        
        'Early binding for easier development
        Dim oApp As Word.Application
        Dim MlMrge As Word.MailMerge
        Dim mmdoc As Word.Document
        Dim docResult As Word.Document
        
        '
        Dim strOutputFolder As String
        Dim strMailMergeMainDocument As String
        Dim strDatabase As String
        Dim bNewWordApp As Boolean
        Dim rec As Long
        Dim strCustID As String
        
        'strMailMergeMainDocument = "C:\My Documents\Access_Databases\JordanDelinq\MailMergeTestDoc.docx"
        'strDatabase = "C:\My Documents\Access_Databases\JordanDelinq\MailTestData.accdb"
        
        'strMailMergeMainDocument = "I:\Allwork\ee\28717544\Customer.docx"
        strMailMergeMainDocument = "C:\My Documents\Access_Databases\JordanDelinq\MailMergeTestDoc.docx"
        
        'strDatabase = "S:\Allwork\Freeola\db1.mdb"
        strDatabase = "C:\My Documents\Access_Databases\JordanDelinq\MailTestData.accdb"
        
        'strOutputFolder = "I:\Allwork\ee\28717544"
        strOutputFolder = "C:\My Documents\Access_Databases\JordanDelinq"
        
        'try to avoid multiple instance of the Word application"
        On Error Resume Next 'temporarily supress error checking
            Set oApp = GetObject(, "Word.Application")
        On Error GoTo 0 'resume error checking
        If oApp Is Nothing Then
            Set oApp = CreateObject(Class:="Word.Application")
            bNewWordApp = True
        End If
        
        oApp.Visible = True
        
        'this will open a new document based on the path as a template.  Excellent
        'but will only open it as a mail merge if the original is a mailmerge document
        Set mmdoc = oApp.Documents.Add(strMailMergeMainDocument)
        ' so start a merge
        Set MlMrge = mmdoc.MailMerge
        With MlMrge
            'do the merge, get the datasource -- and be tricky if the Access app is opened exclusively!
            '
            ' Original //////////////////////////////////////////////
            '
            .OpenDataSource Name:=strDatabase, _
            LinkToSource:=True, AddtoRecentFiles:=False, _
            Connection:="TABLE [tblNameFile]", _
            SQLStatement:="SELECT * FROM [tblNameFile]"
             'do you want merge to email instead
            .Destination = 0 'wdSendToNewDocument
            .SuppressBlankLines = True
            For rec = 1 To .DataSource.RecordCount
                With .DataSource
                
                    .FirstRecord = rec
                    .LastRecord = rec
                    .ActiveRecord = rec
                    strCustID = .DataFields("LastName").Value

                End With
                
                .Execute (False) 'execute and don't stop for errors -- list them in a new Word document, if any.
                
                Set docResult = oApp.ActiveDocument
                'docResult.SaveAs strOutputFolder & "\" & strCustID & ".docx"
                 docResult.SaveAs strOutputFolder & "\" & strCustID & ".docx", wdFormatDocumentDefault
                docResult.SaveAs FileName:=strOutputFolder & "\" & strCustID & ".pdf", FileFormat:=WdSaveFormat.wdFormatPDF
                docResult.Close wdDoNotSaveChanges
            Next rec
        End With
    mmdoc.Close wdDoNotSaveChanges
    If bNewWordApp Then
        oApp.Quit
    End If
End Sub

Open in new window

LVL 1
mlcktmguyAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Najam UddinCommented:
Did you tried
ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
mlcktmguyAuthor Commented:
Thanks you but where would that statement go in the logic I am using.
0
Najam UddinCommented:
Once you have your doc ready this line will give you total page, so I guess by end of your logic
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

mlcktmguyAuthor Commented:
Thanks
0
mlcktmguyAuthor Commented:
Looks like I was premature in awarding the points.  I tried inserting this statement
"numPages = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)"
 into multiple locations in my logic.  The ones that are commented threw an error

'462' The remote server does not exist or is unavailable.

The statement that is currently not commented always return a value of 1, no matter how many pages are in the created document.

Here is the code, all but one of the above statements are commented.

Any ideas?

                .Execute (False) 'execute and don't stop for errors -- list them in a new Word document, if any.
                '
'                numPages = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)
                '
                Set docResult = oApp.ActiveDocument
'                numPages = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)
                'docResult.SaveAs strOutputFolder & "\" & strCustID & ".docx"
                 docResult.SaveAs strOutputFolder & "\" & strCustID & ".docx", wdFormatDocumentDefault
                 
                numPages = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)
                
                docResult.SaveAs FileName:=strOutputFolder & "\" & strCustID & ".pdf", FileFormat:=WdSaveFormat.wdFormatPDF
                docResult.Close wdDoNotSaveChanges
   '             numPages = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)
            Next rec

Open in new window

0
Najam UddinCommented:
try

ActiveDocument.Range.Information(wdNumberOfPagesInDocument)

Open in new window

Also if you can share complete code
1
GrahamSkanRetiredCommented:
Use
numPages = docResult.BuiltInDocumentProperties(wdPropertyPages)

Open in new window

0
mlcktmguyAuthor Commented:
Thanks, this works
ActiveDocument.Range.Information(wdNumberOfPagesInDocument)

Here is the final code:

Public Sub CreateMailMerge_EE3_wPDF()
'
Dim numPages As Long
'
'open the mergedoc
        'late binding for version compatibility
        ''Dim oApp As Object
        ''Dim MlMrge As Object
        
        'Word constants (already defined if early binding)
        Const wdDefaultFirstRecord = 1
        Const wdDefaultLastRecord = -16
        Const wdSendToNewDocument = 0
        Const wdDoNotSaveChanges = 0
        
        'Early binding for easier development
        Dim oApp As Word.Application
        Dim MlMrge As Word.MailMerge
        Dim mmdoc As Word.Document
        Dim docResult As Word.Document
        
        '
        Dim strOutputFolder As String
        Dim strMailMergeMainDocument As String
        Dim strDatabase As String
        Dim bNewWordApp As Boolean
        Dim rec As Long
        Dim strCustID As String
        
        strMailMergeMainDocument = "C:\My Documents\Access_Databases\JordanDelinq\MailMergeTest.docx"
        strDatabase = "C:\My Documents\Access_Databases\JordanDelinq\MailTestData.accdb"
        strOutputFolder = "C:\My Documents\Access_Databases\JordanDelinq"
        
        'try to avoid multiple instance of the Word application"
        On Error Resume Next 'temporarily supress error checking
            Set oApp = GetObject(, "Word.Application")
        On Error GoTo 0 'resume error checking
        If oApp Is Nothing Then
            Set oApp = CreateObject(Class:="Word.Application")
            bNewWordApp = True
        End If
        
        oApp.Visible = True
        
        'this will open a new document based on the path as a template.  Excellent
        'but will only open it as a mail merge if the original is a mailmerge document
        Set mmdoc = oApp.Documents.Add(strMailMergeMainDocument)
        ' so start a merge
        Set MlMrge = mmdoc.MailMerge
        With MlMrge
            'do the merge, get the datasource -- can be tricky if the Access app is opened exclusively!
            '
            ' Original //////////////////////////////////////////////
            '
            .OpenDataSource Name:=strDatabase, _
            LinkToSource:=True, AddtoRecentFiles:=False, _
            Connection:="TABLE [tblNameFile]", _
            SQLStatement:="SELECT * FROM [tblNameFile]"
             'do you want merge to email instead
            .Destination = 0 'wdSendToNewDocument
            .SuppressBlankLines = True
            For rec = 1 To .DataSource.RecordCount
                With .DataSource
                
                    .FirstRecord = rec
                    .LastRecord = rec
                    .ActiveRecord = rec
                    strCustID = .DataFields("LastName").Value

                End With
                
                .Execute (False) 'execute and don't stop for errors -- list them in a new Word document, if any.
                '
                Set docResult = oApp.ActiveDocument
                 docResult.SaveAs strOutputFolder & "\" & strCustID & ".docx", wdFormatDocumentDefault
                numPages = ActiveDocument.Range.Information(wdNumberOfPagesInDocument)
                Debug.Print numPages
                docResult.SaveAs FileName:=strOutputFolder & "\" & strCustID & ".pdf", FileFormat:=WdSaveFormat.wdFormatPDF
                docResult.Close wdDoNotSaveChanges
            Next rec
        End With
    mmdoc.Close wdDoNotSaveChanges
    If bNewWordApp Then
        oApp.Quit
    End If
End Sub

Open in new window

0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.