Convert Word to PDF and preview / Error on PDF replacement
Dear VBA Express,
This is my first time here so apologies if I forgot something to mention.
I have 2 macro’s which are doing the following:
1st macro – Save Word document on open and define a name:
- When opening the Word template it asks by message box to fill in the file name and save it to a defined location
2nd macro – Create PDF:
- When finishing the Word document I convert it to PDF and it saves in the same location as the Word version
- When changing this Word document and convert it again to PDF, it asks me if I want to overwrite the existing PDF yes or no, when I click on no, I am able to change the document name to a revised version.
Now my 2 question:
- When creating the PDF, I do not only want to save the PDF but also want automatically open the PDF after it has been created to view it.
- The second one is an error I get, when creating a PDF from the same document and changing the name to a revised version I get an error message (Option 2 from the 2nd macro): compile error expected function or variable vba - Fault in ActiveDocument.SaveAs2
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
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?
Do While UniqueName = False
DirFile = CurrentFolder & FileName & ".pdf"
If Len(Dir(DirFile)) <> 0 Then
UserAnswer = MsgBox("Deze bestandsnaam bestaat al! Klik " & _
"[Ja] om te overschrijven. Klik [Nee] om te hernoemen.", vbYesNoCancel)
If UserAnswer = vbYes Then
UniqueName = True
ElseIf UserAnswer = vbNo Then
Do
'Retrieve New File Name
FileName = InputBox("Geef een nieuwe bestandsnaam " & _
"(zal opnieuw worden gevraagd wanneer u een ongeldige bestandsnaam opgeeft)", _
"Voer de bestandsnaam in", 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 opgeslagen in de map: " & FolderName
Exit Sub
'Error Handlers
ProblemSaving:
MsgBox "Er was een probleem met het opslaan van uw PDF. Dit wordt meestal veroorzaakt" & _
" door het originele PDF-bestand dat al open is."
Exit Sub
End Sub
Function ValidFileName(FileName As String) As Boolean
'PURPOSE: Determine If A Given Word Document File Name Is Valid
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault
Dim TempPath As String
Dim doc As Document
'Determine Folder Where Temporary Files Are Stored
TempPath = Environ("TEMP")
'Create a Temporary XLS file (XLS in case there are macros)
On Error GoTo InvalidFileName
Set doc = ActiveDocument.SaveAs2(ActiveDocument.TempPath & _
"\" & FileName & ".doc", wdFormatDocument)
On Error Resume Next
'Delete Temp File
Kill doc.FullName
'File Name is Valid
ValidFileName = True
Exit Function
'ERROR HANDLERS
InvalidFileName:
'File Name is Invalid
ValidFileName = False
End Function
------------------------------------------------------------------
Sub AutoNew()
ActiveDocument.SaveAs2 "C:\Users\Offerte proces\Solution offertes\Offertes\" & InputBox("Geef de correcte bestandsnaam op volgens het volgende formaat, OFNXXXXXXX_COMPANY_NAME", "File SaveAs")
End Sub
Thank you very much in advance!
Kind Regards,
Richard
