Hi all,
I am looking for a macro that converts my word document into a pdf file to a default location. But even it is a default location it should ask the user to save it in this default location or save it on a different location. (If people work from home, they do not always have acces to the server).
The filename that would be used to save, should be suggested in a format like "OFNxxxxxxx_Companyname" so everyone uses the same filename format.
If the file already exists, they should be warned and have the ability to change the name.
Summary:
- Convert word to pdf
- Ability to specify default location or select different
- Suggest the user to use standard format
- Notice the user if filename already exists and rename it
I found a lot of macro's that does the trick partially, but I am not able to combine these macro's.
Thank you so much in advance!
Macro to convert to pdf with suggested filename, no specific location:
Code:
Sub MacroSaveAsPDF()
'macro saves pdf either in the same folder where active doc is or in documents folder if file is not yet saved
'
Dim StrPath As String
Dim strPDFname As String
strPDFname = InputBox("Voer de filenaam in van de PDF", "File Name", "OFNxxxxxxx_Companyname")
If strPDFname = "" Then 'user deleted text from inputbox, add default name
strPDFname = "OFNxxxxxxx_Companyname_Nameless"
End If
StrPath = ActiveDocument.Path
If StrPath = "" Then 'doc is not saved yet
StrPath = Options.DefaultFilePath(wdDocumentsPath) & Application.PathSeparator
Else
'just add \ at the end
StrPath = StrPath & Application.PathSeparator
End If
ActiveDocument.ExportAsFixedFormat OutputFileName:= _
StrPath & strPDFname & ".pdf", _
ExportFormat:=wdExportFormatPDF, _
OpenAfterExport:=False, _
OptimizeFor:=wdExportOptimizeForPrint, _
Range:=wdExportAllDocument, _
IncludeDocProps:=True, _
CreateBookmarks:=wdExportCreateWordBookmarks, _
BitmapMissingFonts:=True
End Sub
Macro to convert to pdf with message file already exists:
Code:
Sub SaveToPDF()
Dim StrPath As String, StrName As String, Result
With ActiveDocument
On Error GoTo Errhandler
StrPath = GetFolder & ""
StrName = Split(.Name, ".")(0)
While Dir(StrPath & StrName & ".pdf") <> ""
Result = InputBox("WARNING - A file already exists with the name:" & vbCr & _
Split(.Name, ".")(0) & vbCr & _
"You may edit the filename or continue without editing." _
& vbCr & vbTab & vbTab & vbTab & "Proceed?", "File Exists", StrName)
If Result = vbCancel Then Exit Sub
If StrName = Result Then GoTo Overwrite
StrName = Result
Wend
Overwrite:
.ExportAsFixedFormat OutputFileName:=StrPath & StrName & ".pdf", _
ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, _
OptimizeFor:=wdExportOptimizeForPrint, Range:=wdExportAllDocument, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
End With
Errhandler:
End Sub
Function to choose a folder:
Code:
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function