Created
January 1, 2019 08:37
-
-
Save Climax777/71a6409f623a3b3eb5351c2d91b3fb64 to your computer and use it in GitHub Desktop.
SaveAllAsPDF vb macro for Word
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Sub SaveAllAsPDF() | |
Dim strFilename As String | |
Dim strDocName As String | |
Dim strPath As String | |
Dim oDoc As Document | |
Dim fDialog As FileDialog | |
Dim intPos As Integer | |
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker) | |
With fDialog | |
.Title = "Select folder and click OK" | |
.AllowMultiSelect = False | |
.InitialView = msoFileDialogViewList | |
If .Show <> -1 Then | |
MsgBox "Cancelled By User", , "List Folder Contents" | |
Exit Sub | |
End If | |
strPath = fDialog.SelectedItems.Item(1) | |
If Right(strPath, 1) <> "\" Then strPath = strPath + "\" | |
End With | |
If Documents.Count > 0 Then | |
Documents.Close SaveChanges:=wdPromptToSaveChanges | |
End If | |
If Left(strPath, 1) = Chr(34) Then | |
strPath = Mid(strPath, 2, Len(strPath) - 2) | |
End If | |
strFilename = Dir$(strPath & "*.doc") | |
While Len(strFilename) <> 0 | |
Set oDoc = Documents.Open(strPath & strFilename) | |
strDocName = ActiveDocument.FullName | |
intPos = InStrRev(strDocName, ".") | |
strDocName = Left(strDocName, intPos - 1) | |
'This instruction converts to PDF | |
strDocName = strDocName & ".pdf" | |
oDoc.SaveAs FileName:=strDocName, _ | |
FileFormat:=wdFormatPDF | |
oDoc.Close SaveChanges:=wdDoNotSaveChanges | |
strFilename = Dir$() | |
Wend | |
End Sub | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
This is from https://answers.microsoft.com/en-us/msoffice/forum/all/need-to-batch-convert-word-to-pdf-files/4ee388d3-038f-4c46-a67c-9aacdbdfc2a0?auth=1