-
-
Save sebnilsson/1014112 to your computer and use it in GitHub Desktop.
Sub ConvertWordsToPdfs() | |
Dim directory As String | |
directory = "C:\Wordup" ' The starting directory | |
Dim fso, folder, files | |
Set fso = CreateObject("Scripting.FileSystemObject") | |
Set folder = fso.GetFolder(directory) | |
Set files = folder.files | |
For Each file In files | |
Dim newName As String | |
newName = Replace(file.Path, ".doc", ".pdf") | |
Documents.Open FileName:=file.Path, _ | |
ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _ | |
PasswordDocument:="", PasswordTemplate:="", Revert:=False, _ | |
WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _ | |
wdOpenFormatAuto, XMLTransform:="" | |
ActiveDocument.ExportAsFixedFormat OutputFileName:=newName, _ | |
ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _ | |
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _ | |
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _ | |
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _ | |
BitmapMissingFonts:=True, UseISO19005_1:=False | |
ActiveDocument.Close | |
Next | |
End Sub |
salvaleuven, Have you got any method to avoid the confirmation dialog, programmatically?
@salvaleuven, you could try Application.DisplayAlerts = False and Application.DisplayAlerts = True at the end. Also, about the subfolders, check the link below.
https://stackoverflow.com/a/22645439/2449724
Thanks for this code, @sebnilsson, it is really useful!
If this code is used on .docx files, it results in the invalid extension .pdfx. (This is a curious bug, since the .docx format was introduced with Office 2007.) The problem can be avoided by replacing line 15 with these two statements:
newName = Replace(file.Path, ".docx", ".pdf")
newName = Replace(newName, ".docx", ".pdf")
Only one of the two replacements will make any change in the string, so the result will be a .pdf extension in either case.
I encounter a Run-Time error '424' Object Required at line 17. I made sure to select Microsoft Scripting Runtime in References - VBAProject.
Can someone help?
Same here as snicker40. Showing Run-Time error '424' Object Required at line 17. However I am trying to convert a folder of pdfs into docs. So I made slight changes in the original code posted here.
Please look at it and suggest me where I need to make changes in order to get the macro running.
Sub ConvertPdfsToDocs()
Dim directory As String
directory = "E:\Sayan\Sayan_May_2018\Rajeev data cleaning\Invoice extraction May2018\PDF invoices\06_06_18_Batch8_total\Batch8_sayan\" ' The starting directory
Dim fso, newFile, folder, files
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(directory)
Set files = folder.files
For Each file In files
Dim newName As String
newName = Replace(file.path, ".pdf", ".doc")
Documents.Open FileName:=file.path, _
ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _
PasswordDocument:="", PasswordTemplate:="", Revert:=False, _
WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _
wdOpenFormatAuto, XMLTransform:=""
ActiveDocument.ExportAsFixedFormat OutputFileName:=newName, _
ExportFormat:=wdExportFormatDOC, OpenAfterExport:=False, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
ActiveDocument.Close
Next
End Sub
same issue here. Error 424 any answers?
You need to enable Reference Microsoft Word if not enabled. Thanks @sebnilsson, & @mvpjjf.
#same issue here. Error 424 any answers?
Sub ConvertWordsToPdfs()
Dim directory As String
Dim fldr As Object
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select folder with Word files to export to PDF"
.AllowMultiSelect = False
If .Show <> -1 Then Exit Sub
directory = .SelectedItems(1)
End With
Dim fso, newFile, folder, files
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(directory)
Set files = folder.files
For Each file In files
Dim newName As String
newName = Replace(file.Path, ".docx", ".pdf")
newName = Replace(newName, ".doc", ".pdf")
'Debug.Print file.Path
Documents.Open Filename:=file.Path, _
ConfirmConversions:=False, _
ReadOnly:=False, _
AddToRecentFiles:=False, _
PasswordDocument:="", _
PasswordTemplate:="", _
Revert:=False, _
WritePasswordDocument:="", _
WritePasswordTemplate:="", _
Format:= _
wdOpenFormatAuto, _
XMLTransform:=""
ActiveDocument.ExportAsFixedFormat OutputFileName:=newName, _
ExportFormat:=wdExportFormatPDF, _
OpenAfterExport:=False, _
OptimizeFor:= _
wdExportOptimizeForPrint, _
Range:=wdExportAllDocument, _
From:=1, To:=1, _
Item:=wdExportDocumentContent, _
IncludeDocProps:=True, _
KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, _
DocStructureTags:=True, _
BitmapMissingFonts:=True, _
UseISO19005_1:=False
ActiveDocument.Close
Next
End Sub
Nice code! how could it be modified to include subdirectories? also when i launch it, words ask for confirmation of save changes of several files. How could this be avoided?
Thanks in advance!!