我可以更改文档中的另存为目的地，以便我收到一个选择目的地的弹出窗口吗？

问题描述

现在下面的代码正在运行，但它会自动保存在代码中定义的文件夹中。

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

我想更改我可以选择保存目的地的代码，所以如果我按下按钮，我会收到一个弹出窗口。

解决方法

例如：

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