Word Document to PDF

WordDocToPdf.vba

Sub WordDoc_To_Pdf()
  ActiveDocument.ExportAsFixedFormat OutputFileName:=ActiveDocument.FullName + ".pdf", _
                                     ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
                                     wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, to:=99, _
                                     Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
                                     CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
                                     BitmapMissingFonts:=True, UseISO19005_1:=True

End Sub

Sub WordDoc_To_PdfByFolder()

  On Error Resume Next

  Dim xlApp
  Dim xlBook
  Dim sPath

  Dim fso
  Dim ObjFolder
  Dim ObjFiles
  Dim ObjFile

  'make an object with the excel application
  Set xlApp = CreateObject("Word.Application")
  xlApp.DisplayAlerts = False

  'Creating File System Object
  Set fso = CreateObject("Scripting.FileSystemObject")

  'Getting the Folder Object
  Set ObjFolder = fso.GetFolder("C:\temp\doc\")

  'Getting the list of Files
  Set ObjFiles = ObjFolder.Files

  'Running the macro on each file
  For Each ObjFile In ObjFiles
      'MsgBox (ObjFolder & "\" & ObjFile.Name) ' Debug Folder Locations
      ' Note the from 1 to 99...
      If ((fso.GetExtensionName(ObjFile) = "doc") Or (fso.GetExtensionName(ObjFile) = "docx")) Then
          Debug.Print fso.GetExtensionName(ObjFile)
          Set xlBook = xlApp.Documents.Open(ObjFile.Path, 0, False)
          xlApp.ActiveDocument.ExportAsFixedFormat OutputFileName:=ObjFile.Path + ".pdf", _
                                         ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
                                         wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, to:=99, _
                                         Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
                                         CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
                                         BitmapMissingFonts:=True, UseISO19005_1:=True
          xlApp.ActiveDocument.Close
          xlApp.Close
      End If
  Next

  xlApp.Quit
  Set xlBook = Nothing
  Set xlApp = Nothing

End Sub