VBA Export to PDF

[drifter96]

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"

Documents(strOrigDoc).Activate

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
objProgressBar.Show
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
Selection.Bookmarks("\Page").Select

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

If (InStr(Selection, "-GEN")) > 0 Then
strFolder = strIgnore
Else
If (InStr(Selection, "INTERNAL")) > 0 Then
strFolder = strEmail
Else
If (InStr(Selection, "FX")) > 0 Then
strFolder = strFax
Else
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-----

Loop

Application.Quit SaveChanges:=wdDoNotSaveChanges

End Sub