Omzetten Word document naar losse PDF's

Sub Splitter()
'------------------------------------------------------------------------------------------------------------------
' splitter Macro
' Macro created by Doug Robbins to save each letter created by a mailmerge as a separate file.
'------------------------------------------------------------------------------------------------------------------
Dim Letters As Integer, Counter As Integer
Dim DocName As String, sRange As String
Dim Pad As String, sNullen As String
Dim aRange As Range

DocName = "Brief "
Pad = "H:\Temp\Word\"

Letters = ActiveDocument.Sections.Count
Selection.HomeKey Unit:=wdStory
Counter = 1

While Counter < Letters
    ActiveDocument.Sections.First.Range.Cut
    Documents.Add
    Selection.Paste
    '-----------------------------------------------------------------------------
    'Naam samenstellen uit 1e alinea van tekst
    '-----------------------------------------------------------------------------
    Set aRange = ActiveDocument.Paragraphs(1).Range
    DocName = aRange.Text
    If Right(DocName, 1) = Chr(13) Or Right(DocName, 1) = Chr(10) Then
        DocName = Left(DocName, Len(DocName) - 1)
    End If
    '-----------------------------------------------------------------------------
    ActiveDocument.Sections(2).PageSetup.SectionStart = wdSectionContinuous
    ActiveDocument.SaveAs FileName:=Pad & DocName & ".doc", FileFormat:=wdFormatDocument, LockComments:=False, _
        Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
        EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, _
        SaveFormsData:=False, SaveAsAOCELetter:=False
    ActiveWindow.Close
    Counter = Counter + 1
Wend

End Sub

Sub Splitter()
'------------------------------------------------------------------------------------------------------------------
' splitter Macro
' Macro created by Doug Robbins to save each letter created by a mailmerge as a separate file.
'------------------------------------------------------------------------------------------------------------------
Dim Letters As Integer, Counter As Integer
Dim DocName As String, sRange As String
Dim Pad As String, sNullen As String
Dim aRange As Range

    DocName = "Brief "
    Pad = "H:\Temp\Word\"
    
    Letters = ActiveDocument.Sections.Count
    Selection.HomeKey Unit:=wdStory
    Counter = 1

    While Counter < Letters
        ActiveDocument.Sections.First.Range.Cut
        Documents.Add
        Selection.Paste
        '-----------------------------------------------------------------------------
        'Naam samenstellen uit 1e alinea van tekst
        '-----------------------------------------------------------------------------
        Set aRange = ActiveDocument.Paragraphs(1).Range
        DocName = aRange.Text
        If Right(DocName, 1) = Chr(13) Or Right(DocName, 1) = Chr(10) Then
            DocName = Left(DocName, Len(DocName) - 1)
        End If
        '-----------------------------------------------------------------------------
        ActiveDocument.Sections(2).PageSetup.SectionStart = wdSectionContinuous
        ActiveDocument.SaveAs FileName:=Pad & DocName & ".doc", FileFormat:=wdFormatDocument, LockComments:=False, _
            Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
            EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, _
            SaveFormsData:=False, SaveAsAOCELetter:=False
[B][COLOR="#0000FF"]            .ExportAsFixedFormat OutputFileName:=Pad & DocName & ".pdf", ExportFormat:=wdExportFormatPDF, _
                OpenAfterExport:=True, OptimizeFor:=wdExportOptimizeForPrint, IncludeDocProps:=True, _
                Item:=wdExportDocumentContent, CreateBookmarks:=wdExportCreateHeadingBookmarks
[/COLOR][/B]        ActiveWindow.Close
        Counter = Counter + 1
    Wend

End Sub

Sub M_snb()
  for each it in activedocument.sections
    it.Range.ExportAsFixedFormat "G:\OF\brief" & it.index & ".pdf", 17
  next 
End Sub