Question

我正在开发邮件合并导出功能。我想添加一个“选择文件夹”对话框。

我在google搜索中找到了类似的内容（browse button in input box to find file Excel2007 Vba），但我想选择一个文件夹，而不是文件。文件名和类型是通过导出自动生成的。

Sub Export_Docs()
    'Used to set criteria for moving through the document by section.
    Application.Browser.Target = wdBrowseSection

    'A mailmerge document ends with a section break next page.
    'Subtracting one from the section count stop error message.
    For i = 1 To ((ActiveDocument.Sections.Count) - 1)

      'Select and copy the section text to the clipboard
      ActiveDocument.Bookmarks("\Section").Range.Copy

      'Create a new document to paste text from clipboard.
      Documents.Add
      'To save your document with the original formatting'
      Selection.PasteAndFormat (wdFormatOriginalFormatting)

      'Removes the break that is copied at the end of the section, if any.
      Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
      Selection.Delete Unit:=wdCharacter, Count:=1
      'Sets Save Location and Document Name Parameters'

      ChangeFileOpenDirectory "C:\Users\tveinot\Documents\Asset Management\Buildings\"
      MyString = ActiveDocument.Tables(1).Cell(6, 3).Range.Text
      Filename = Left(MyString, 13)
      DocNum = DocNum + 1
      ActiveDocument.SaveAs Filename:=Filename & ".doc"
      ActiveDocument.Close
      'Move the selection to the next section in the document
      Application.Browser.Next
    Next i
    ActiveDocument.Close savechanges:=wdDoNotSaveChanges
End Sub

Answer 1

首先Google match给了我this：

Function GetFolder(strPath As String) As String
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = strPath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetFolder = sItem
    Set fldr = Nothing
End Function

经过测试：效果很好。在上面的代码中，您还可以看到它们如何设置初始路径。

MS Word的文件夹选取器

1 个答案: