Batch save files as PDF

[Mashtonsmith]

Sorry to post on an Excel board...

But I need a quick way to save multiple Word.docs as multiple PDF's.

Possible ?

Thank you!

 

[ranman256]

what? Save all active open docs?
or select the docs in a folder?

 

[Mashtonsmith]

All docs in a folder ideally

 

[Mashtonsmith]

Any ideas?

 

[ranman256]

in vbe (alt-F11) insert a module,
paste this code into it.
set the folder you want to use in,SaveAll2PDF

then run: SaveAll2PDF

Public Sub SaveAll2PDF()
  SavellFilesInDirAsPDF "c:\temp\"
  MsgBox "Done"
End Sub

'-------------
Private Sub SavellFilesInDirAsPDF(ByVal pvDir)
'-------------
Dim FSO, oFolder, oFile, oRX
Dim sTxt As String, sFile As String
Dim vTargFile
Dim i As Long


Set FSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = FSO.GetFolder(pvDir)


If Right(pvDir, 1) = "\" Then pvDir = pvDir & "\"


For Each oFile In oFolder.Files
  If InStr(oFile.Name, ".doc") > 0 Then            'docs only
       sFile = pvDir & oFile.Name
       Documents.Open sFile
       
       i = InStrRev(oFile.Name, ".doc")
       vTargFile = pvDir & Left(oFile.Name, i) & "pdf"
       Save1Pdf vTargFile
       ActiveDocument.Close False
  End If
Next


Set oFile = Nothing
Set oFolder = Nothing
Set FSO = Nothing
End Sub


Private Sub Save1Pdf(ByVal pvFile)

If FileExists(pvFile) Then KillFile (pvFile)

    ActiveDocument.ExportAsFixedFormat OutputFileName:=pvFile, _
         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
End Sub


Public Function FileExists(ByVal pvFile) As Boolean
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
FileExists = FSO.FileExists(pvFile)
Set FSO = Nothing
End Function


Public Sub KillFile(ByVal pvFile)
Dim FSO
On Error Resume Next
Set FSO = CreateObject("Scripting.FileSystemObject")
'FileReadOnly pvFile, False
FSO.DeleteFile pvFile
Set FSO = Nothing
End Sub

 

[Mashtonsmith]

Thank you!
Ideally it would prompt you to choose a folder when you run it?