1
votes

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

1
can you show the whole of your code?Kazimierz Jawor
I have updated the question now. Thanks.steve
it is not valid code for sure, there are some obvious errors which you should improve first. You should also explain what is in fact 'user input' and how it refers to 'splitting' process.Kazimierz Jawor

1 Answers

0
votes

In Step 2 (Looping through the page sets), just after you do the paste (line 57) add the following:

    ' There is now an empty page at the end of the document.
    ' This is caused by a section break. Get rid of it.
    Selection.MoveLeft
    Selection.Delete

Remove the extra code looping through the sections.