Could I change the save as destination from the document so I receive a pop-up to select the destination?

47 Views Asked by At

In the moment the following coding is working but it saves automatically in a folder which is defined in the code.

Private Sub CommandButton2_Click()

' Button PDF '

    ActiveDocument.ExportAsFixedFormat OutputFileName:= _
    "\\Desktop\Test_PDF.pdf", ExportFormat:= _
    wdExportFormatPDF, OpenAfterExport:=True, OptimizeFor:= _
    wdExportOptimizeForPrint, Range:=wdExportFromTo, From:=2, To:=7, Item:= _
    wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
    CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
    BitmapMissingFonts:=True, UseISO19005_1:=False

End Sub

I want to change the code that I can select the saving destination, so I receive a pop-up if I press the button.

1

There are 1 best solutions below

0
On

For example:

Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, strTxt As String
strFolder = GetFolder
If strFolder = "" Then
  MsgBox "No Save Folder Selected!", vbCritical
  Exit Sub
Else
ActiveDocument.ExportAsFixedFormat _
  OutputFileName:=strFolder & "\Test_PDF.pdf", ExportFormat:=wdExportFormatPDF, _
    OpenAfterExport:=True, OptimizeFor:=wdExportOptimizeForPrint, _
    Range:=wdExportFromTo, From:=2, To:=7, Item:=wdExportDocumentContent, _
    IncludeDocProps:=True, KeepIRM:=True, CreateBookmarks:=wdExportCreateNoBookmarks, _
    DocStructureTags:=True, BitmapMissingFonts:=True, UseISO19005_1:=False
End If
Application.ScreenUpdating = True
End Sub

Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose the folder to save in", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function