Trying to create a VBA in Word that breaks a document down and exports the broken down pieces to a PDF

Viewed 32

Disclaimer - I am in no way an expert at this, I have cobbled pieces of macros / vba I've collected over the years to create a Macro we really need.

Basically, we to export one large word document, which contains up a number of separate letters, to a PDF with a specific file name with the macro also splitting down the word document by each signature page.

Here is what I have come up with so far, but I'm not sure what part to remove to stop it printing and just do the export. And at the moment it just exports the whole word document each time.

Any help you can provide would be amazing, thank you!

Sub Print() 
Dim path
Dim reminder As Integer
Dim oExtension As String
Dim Fso, oFolder, oSubfolder, oFile, queue As Collection

On Error Resume Next

path = "C:\Mailmerge"

If optionCancel = "yes" Then
optionCancel = "No"
Exit Sub
End If

reminder = MsgBox("Are you sure you want to export these files?", 4, "WARNING !!")

If reminder = 6 Then    'If Yes is clicked

Set Fso = CreateObject("Scripting.FileSystemObject")
Set queue = New Collection
queue.Add Fso.GetFolder(path) 'The path

Do While queue.Count > 0
Set oFolder = queue(1)
queue.Remove 1 'dequeue
'...insert any <<folder>> processing code here...
For Each oSubfolder In oFolder.subfolders
queue.Add oSubfolder 'enqueue
Next oSubfolder
For Each oFile In oFolder.Files

oExtension = Right(oFile, Len(oFile) - InStrRev(oFile, ".", -1)) 'gets the file extension

If oExtension = "docx" Or oExtension = "DOCX" Or oExtension = "doc" Or oExtension = "DOC" Or oExtension = "docm" Or oExtension = "DOCM" Or oExtension = "rtf" Or oExtension = "RTF" Then

Documents.Open FileName:=(oFile)

    Selection.EndKey Unit:=wdStory
    Selection.InsertBreak Type:=wdSectionBreakNextPage
Dim Letters As Long
Dim Counter As Long
Letters = ActiveDocument.Sections.Count
Counter = 1
While Counter < Letters
ActiveDocument.PrintOut Background:=False, _
Range:=wdPrintFromTo, _
From:="s" & Format(Counter), To:="s" & Format(Counter)
Counter = Counter + 1
   
    Dim extra_text As String
    Dim file_name As String
    Dim final_text As String
    Dim MyDate
    Dim MyNumber
    
    MyDate = Format(Date, "YYYYMMDD")
    MyNumber = Int((99999 - 11111 + 1) * Rnd + 11111)
    extra_text = "-ALBA"
    final_text = "A_"
    file_name = final_text & MyDate & extra_text & MyNumber & ".pdf"

    ActiveDocument.ExportAsFixedFormat OutputFileName:=file_name, _
    ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
    wdExportOptimizeForPrint, Range:=wdExportAllDocument, Item:= _
    wdExportDocumentContent, IncludeDocProps:=False, KeepIRM:=True, _
    CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
    BitmapMissingFonts:=True, UseISO19005_1:=False

Wend


ActiveDocument.Saved = True  'to prevent asking to save

ActiveDocument.Close         'Closes document


End If

Next oFile

Loop

Else

MsgBox ("Operation cancelled!!")

End If

End Sub
0 Answers
Related