VBA Batch convert to PDF

floggingmolly

Board Regular
Joined
Sep 14, 2019
Messages
85
I have a macro that batch converts word documents to PDF. It works, but sometimes the word documents are in both .doc and .docx. Is there a way to alter the code so it will do both extensions? I tried to alter the code but it was changing .doc to PDF and .docx to PDFX. Any help would be appreciated. Below is the code I am using.

Code:
Sub ConvertMultipleWordToPDF()
 
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
Dim OpenSourceFolder As Object, OpenTargetFolder As Object
Dim SelectedWordFilesFolder As String, SelectedPdfFilesFolder As String
Dim InputWordFile As String, OutputPdfFile As String
 
 
Dim objWordApp As Word.Application
Dim objMyWordFile As Word.Document
Set objWordApp = CreateObject("Word.Application")
 
 
Set OpenSourceFolder = Application.FileDialog(msoFileDialogFolderPicker)
Set OpenTargetFolder = Application.FileDialog(msoFileDialogFolderPicker)
 
'Select input file folder
MsgBox ("Select input folder where word files are stored")
Set OpenSourceFolder = Application.FileDialog(msoFileDialogFolderPicker)
 
If OpenSourceFolder.Show = -1 Then
SelectedWordFilesFolder = OpenSourceFolder.SelectedItems(1)
End If
 
 
If SelectedWordFilesFolder = "" Then
MsgBox "No input folder selected, code will exit"
Exit Sub
End If
 
 
AppActivate Application.Caption
 
'Select output file folder
MsgBox ("Select output folder where PDF files are stored")
If OpenTargetFolder.Show = -1 Then
SelectedPdfFilesFolder = OpenTargetFolder.SelectedItems(1)
End If
 
 
If SelectedPdfFilesFolder = "" Then
MsgBox "No output folder selected, code will exit"
Exit Sub
End If
 
 
 
'Looping through only word files in input file folder
InputWordFile = Dir(SelectedWordFilesFolder & "\*.doc")

While InputWordFile <> ""
          
Set objMyWordFile = objWordApp.Documents.Open(SelectedWordFilesFolder & "\" & InputWordFile)
objWordApp.Visible = True
OutputPdfFile = SelectedPdfFilesFolder & "\" & Replace(objMyWordFile.Name, "doc", "pdf")

objWordApp.ActiveDocument.ExportAsFixedFormat OutputFileName:=OutputPdfFile, ExportFormat:=wdExportFormatPDF
      
objMyWordFile.Close
InputWordFile = Dir
Wend
 
objWordApp.Documents.Application.Quit
 
End Sub
 

Some videos you may like

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,619
Office Version
  1. 2007
Platform
  1. Windows
Change this line:
OutputPdfFile = SelectedPdfFilesFolder & "\" & Replace(objMyWordFile.Name, "doc", "pdf")

For this:
OutputPdfFile = SelectedPdfFilesFolder & "\" & Left(objMyWordFile.Name, InStrRev(objMyWordFile.Name, ".") - 1) & ".pdf"
 

floggingmolly

Board Regular
Joined
Sep 14, 2019
Messages
85
Change this line:
OutputPdfFile = SelectedPdfFilesFolder & "\" & Replace(objMyWordFile.Name, "doc", "pdf")

For this:
OutputPdfFile = SelectedPdfFilesFolder & "\" & Left(objMyWordFile.Name, InStrRev(objMyWordFile.Name, ".") - 1) & ".pdf"
I tried this but it didn't work. The .docx were saved as PDF but the .doc files it skipped and they weren't saved.
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,619
Office Version
  1. 2007
Platform
  1. Windows
Try this
Change this line:
OutputPdfFile = SelectedPdfFilesFolder & "\" & Replace(objMyWordFile.Name, "doc", "pdf")

For these
VBA Code:
  If LCase(Right(objMyWordFile.Name, 1)) = "x" Then
    OutputPdfFile = SelectedPdfFilesFolder & "\" & Replace(objMyWordFile.Name, "docx", "pdf")
  Else
    OutputPdfFile = SelectedPdfFilesFolder & "\" & Replace(objMyWordFile.Name, "doc", "pdf")
  End If
 

floggingmolly

Board Regular
Joined
Sep 14, 2019
Messages
85

ADVERTISEMENT

Try this
Change this line:
OutputPdfFile = SelectedPdfFilesFolder & "\" & Replace(objMyWordFile.Name, "doc", "pdf")

For these
VBA Code:
  If LCase(Right(objMyWordFile.Name, 1)) = "x" Then
    OutputPdfFile = SelectedPdfFilesFolder & "\" & Replace(objMyWordFile.Name, "docx", "pdf")
  Else
    OutputPdfFile = SelectedPdfFilesFolder & "\" & Replace(objMyWordFile.Name, "doc", "pdf")
  End If
This worked but I had to add another line InputWordFile = Dir(SelectedWordFilesFolder & "\*.doc")
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,619
Office Version
  1. 2007
Platform
  1. Windows
I'm glad to help you. Thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,127,610
Messages
5,625,800
Members
416,138
Latest member
Pizzaman22

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top