I have created a macro which, based on user input, splits the Word document into smaller documents and then outputs them as a .pdf with a unique name. Each individual document though is outputting with an extra blank page on the back, which at no point is in the original document. Is there any way to stop this happening/remove the back page before saving to .pdf? I have tried removing the final page by section break but that also didn't work.
Sub SplitToPDF()
Dim docMultiple As Document
Dim docSingle As Document
Dim rngPage As Range
Dim iCurrentPage As Integer
Dim iPageCount As Integer
Dim strNewFileName As String
Dim fDialog As FileDialog
Dim x As Integer
Dim Response As VbMsgBoxResult
Dim userInput As Integer
Dim fso
Dim currentDate As String
Dim customerName As String
Dim currentMonth As String
Dim currentYear As Integer
Response = MsgBox("Insturctions for use:" & vbNewLine & "Please ensure the first blank page has been deleted." & vbNewLine & "Please ensure you have saved (and re-named) this document to the fund operation name." & vbNewLine & vbNewLine & "This will also overwrite any other split you have done in the same folder. Continue?", vbExclamation + vbYesNo, "Warning!")
If Response = vbNo Then Exit Sub
inputData = InputBox("Please enter the length of each letter below.", "Notice length:")
If inputData = "" Then Exit Sub
' 1 Create dialog for saving and get directory details
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
With fDialog
.Title = "Select folder to save split files"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then
MsgBox "Cancelled By User", vbInformation
Exit Sub
End If
DocDir = fDialog.SelectedItems.Item(1)
End With
Application.ScreenUpdating = False
Set docMultiple = ActiveDocument
Set rngPage = docMultiple.Range
iCurrentPage = 1
iPageCount = docMultiple.BuiltInDocumentProperties(wdPropertyPages)
' 2 Loop through each page set and copy/paste data
Do Until iCurrentPage > iPageCount
If iCurrentPage = iPageCount Then
rngPage.End = ActiveDocument.Range.End
Else
Selection.GoTo wdGoToPage, wdGoToAbsolute, iCurrentPage + inputData
rngPage.End = Selection.Start
End If
rngPage.Copy
Set docSingle = Documents.Add
docSingle.Range.Paste
For i = 0 To docSingle.Sections.Count
Next
Set delSec = docSingle.Sections(i)
delSec.Range.Delete
' 3 Variable for document name
Application.Selection.Find.Execute "customer: "
Application.Selection.Expand wdLine
customerName = Replace(Application.Selection.Text, "customer: ", "")
x = Len(customerName) - 1
customerName = Left(customerName, x)
Set fso = CreateObject("Scripting.FileSystemObject")
currentDate = Replace(Date, "/", "-")
currentMonth = Format(currentDate, "MMM")
currentYear = Format(currentDate, "YY")
currentDate = currentMonth & "_" & currentYear
strNewFileName = fso.GetBaseName(docMultiple) & "_" & currentDate & "_" & customerName & ".pdf"
docSingle.SaveAs FileName:=DocDir & "\" & strNewFileName, FileFormat:=wdFormatPDF
iCurrentPage = iCurrentPage + inputData
docSingle.Close SaveChanges:=wdDoNotSaveChanges
rngPage.Collapse wdCollapseEnd
Loop
Application.ScreenUpdating = True
MsgBox "Complete", vbInformation
Set docMultiple = Nothing
Set docSingle = Nothing
Set rngPage = Nothing
End Sub