Skip to content

Instantly share code, notes, and snippets.

@boyboi86

boyboi86/SaveAsPDF.docx

Created July 23, 2017 13:19
Show Gist options
  • Save boyboi86/cd7b12dada808bd56bc0698444238118 to your computer and use it in GitHub Desktop.
Save boyboi86/cd7b12dada808bd56bc0698444238118 to your computer and use it in GitHub Desktop.
Download ZIP
MS word convert to PDF and save
Raw
SaveAsPDF.docx
Option Explicit
Sub AllSectionsToSubDoc()
Dim x As Long
Dim Sections As Long
Dim Doc As Document
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set Doc = ActiveDocument
Sections = Doc.Sections.Count
For x = Sections - 1 To 1 Step -1
Doc.Sections(x).Range.Copy
Documents.Add
ActiveDocument.Range.Paste
ActiveDocument.SaveAs (Doc.Path & "\" & x & ".doc")
ActiveDocument.Close False
Next x
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
@boyboi86
Copy link
Author

boyboi86 commented Jul 23, 2017 •
edited
Loading

Sub merge1record_at_a_time()'
' merge1record_at_a_time Macro
'
'
Dim fd As FileDialog

'Create a FileDialog object as a Folder Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd


    'Use the Show method to display the Folder Picker dialog box and return the user's action.
    'The user pressed the button.
    If .Show = -1 Then
            For Each vrtSelectedItem In .SelectedItems


            'vrtSelectedItem is aString that contains the path of each selected item.
            'You can use any file I/O functions that you want to work with this path.
            'This example displays the path in a message box.
    SelectedPath = vrtSelectedItem


    Next vrtSelectedItem


    Else
    MsgBox ("No Directory Selected.  Exiting")
    Exit Sub
    End If
End With


'Set the object variable to Nothing.
Set fd = Nothing

Application.ScreenUpdating = False

MainDoc = ActiveDocument.Name
ChangeFileOpenDirectory SelectedPath
For i = 1 To ActiveDocument.MailMerge.DataSource.RecordCount
With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = i
.LastRecord = i
.ActiveRecord = i
docname = .DataFields("ASP_Print").Value & ".docx" ' ADDED CODE
End With
.Execute Pause:=False
Application.ScreenUpdating = False

    End With

ActiveDocument.ExportAsFixedFormat OutputFileName:=docName, _
ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _ 'set OpenAfterExport to False so the PDF files won't open after mail merge
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False

Windows(MainDoc).Activate
Next i

Application.ScreenUpdating = True

End Sub

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment