VBA Export to PDF

May 3, 2022
Reaction score
I am working with VBA and scrolling through a word document page by page and exporting each page to a separate PDF file. It works fine except it creates a 2 page PDF document each time. The page I am exporting and a blank page after it. I need to stop that second blank page from being created on every PDF.

Here is my code:

Dim intPage As Integer
Dim intPageCount As Integer
Dim strPath As String
Dim strOrigDoc As String
Dim strEmail As String
Dim strFax As String
Dim strIgnore As String
Dim strOther As String

strEmail = "\\Pfil9903\accessusers\Database Files\Payoff Quotes Statement Database\Documentation\Test\Email"
strFax = "\\Pfil9903\accessusers\Database Files\Payoff Quotes Statement Database\Documentation\Test\Fax"
strIgnore = "\\Pfil9903\accessusers\Database Files\Payoff Quotes Statement Database\Documentation\Test\Ignore"
strOther = "\\Pfil9903\accessusers\Database Files\Payoff Quotes Statement Database\Documentation\Test\Other"

strPath = "\\Pfil9903\accessusers\Database Files\Payoff Quotes Statement Database\Documentation\"

strOrigDoc = strPath & "Convert.docm"


intPageCount = ActiveDocument.ActiveWindow.ActivePane.Pages.Count

intPage = 1

Do While intPage < intPageCount + 1

'-----Progress Bar-----
Dim j As Long
Dim pctdone As Single
Dim objProgressBar As ufProgress

Set objProgressBar = New ufProgress

objProgressBar.LabelProgress.Width = 0
For j = 1 To intPageCount

pctdone = j / intPageCount
With objProgressBar
.LabelCaption.Caption = " Processing Page " & j & " of " & intPageCount
.LabelProgress.Width = pctdone * (.FrameProgress.Width)
End With

Doze (50)
'-----Progress Bar-----

Dim strLN As String
Dim strLNLoc As String
Dim strFolder As String

Selection.GoTo wdGoToPage, wdGoToAbsolute, intPage

If Len(Selection) < 300 Then
If InStr(Selection, "REAL ESTATE") Then
strLNLoc = InStr(Selection, "LOAN NUMBER")
strLN = Trim(Mid(Selection, strLNLoc + 11, 18))

If (InStr(Selection, "-GEN")) > 0 Then
strFolder = strIgnore
If (InStr(Selection, "INTERNAL")) > 0 Then
strFolder = strEmail
If (InStr(Selection, "FX")) > 0 Then
strFolder = strFax
strFolder = strOther
End If
End If
End If

With ActiveDocument
Selection.ExportAsFixedFormat OutputFileName:=strFolder & "\" & strLN & ".pdf", ExportFormat:=wdExportFormatPDF, _
OpenAfterExport:=False, Item:=wdExportDocumentContent, IncludeDocProps:=False, KeepIRM:=False, _
DocStructureTags:=True, BitmapMissingFonts:=False, UseISO19005_1:=False
End With

End If
End If

intPage = intPage + 1

'-----Progress Bar-----
If intPage = intPageCount Then Unload objProgressBar
Next j
'-----Progress Bar-----


Application.Quit SaveChanges:=wdDoNotSaveChanges

End Sub

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question