Export Word document as PDF using Excel VBA

I am in search of some Excel VBA code that will open an existing Word document (no need to make it Visible), then convert and save it as a PDF, to another location.

Many thanks in advance for the consistently great help from you all!

Excel Facts

Show numbers in thousands?

Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand

vikas_newports

Board Regular
  1. 365
  1. Windows
Sub Word_ExportPDF() 'PURPOSE: Generate A PDF Document From Current Word Document 'NOTES: PDF Will Be Saved To Same Folder As Word Document File 'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault Dim CurrentFolder As String Dim FileName As String Dim myPath As String Dim UniqueName As Boolean UniqueName = False 'Store Information About Word File myPath = ActiveDocument.FullName CurrentFolder = ActiveDocument.Path & "\" FileName = Mid(myPath, InStrRev(myPath, "\") + 1, _ InStrRev(myPath, ".") - InStrRev(myPath, "\") - 1) 'Does File Already Exist? Do While UniqueName = False DirFile = CurrentFolder & FileName & ".pdf" If Len(Dir(DirFile)) <> 0 Then UserAnswer = MsgBox("File Already Exists! Click " & _ "[Yes] to override. Click [No] to Rename.", vbYesNoCancel) If UserAnswer = vbYes Then UniqueName = True ElseIf UserAnswer = vbNo Then Do 'Retrieve New File Name FileName = InputBox("Provide New File Name " & _ "(will ask again if you provide an invalid file name)", _ "Enter File Name", FileName) 'Exit if User Wants To If FileName = "False" Or FileName = "" Then Exit Sub Loop While ValidFileName(FileName) = False Else Exit Sub 'Cancel End If Else UniqueName = True End If Loop 'Save As PDF Document On Error GoTo ProblemSaving ActiveDocument.ExportAsFixedFormat _ OutputFileName:=CurrentFolder & FileName & ".pdf", _ ExportFormat:=wdExportFormatPDF On Error GoTo 0 'Confirm Save To User With ActiveDocument FolderName = Mid(.Path, InStrRev(.Path, "\") + 1, Len(.Path) - InStrRev(.Path, "\")) End With MsgBox "PDF Saved in the Folder: " & FolderName Exit Sub 'Error Handlers ProblemSaving: MsgBox "There was a problem saving your PDF. This is most commonly caused" & _ " by the original PDF file already being open." Exit Sub End Sub