01-16-2021, 12:15 AM
|
Advanced Beginner
|
|
Join Date: Jan 2021
Posts: 32
|
|
can we add export to PDF funtionality?
Thanks, macropod, this is perfect.
I actually also need to convert each document to a PDF, saving over any PDFs that are already there with the same names.
In order to do this, I tried to just modify your code like so.
I added:
Just before:
Code:
.Close SaveChanges:=True
Which would call this:
Code:
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?
'If so, too bad
' 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
However, that led to an "Invalid Procedure call or argument (Error 5)" on:
Code:
FileName = Mid(myPath, InStrRev(myPath, "\") + 1, _
InStrRev(myPath, ".") - InStrRev(myPath, "\") - 1)
I googled around, and the issue seems to have something to do with the limits of Mid, but I'm not sure how to correct it.
Of course, this problem has nothing to do with your code. If you want to suggest another way to add conversion to PDFs from within what you wrote, that's fine too. Many thanks.
|