View Single Post
 
Old 11-18-2020, 09:36 AM
richardgo richardgo is offline Windows 10 Office 2016
Novice
 
Join Date: Nov 2020
Posts: 1
richardgo is on a distinguished road
Default VBA to save word document as pdf to default location with inputbox to “save as” with filename sugge

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:
  1. Convert word to pdf
  2. Ability to specify default location or select different
  3. Suggest the user to use standard format
  4. 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

Last edited by Charles Kenyon; 11-18-2020 at 11:29 AM. Reason: improve readability of formatting
Reply With Quote