vba - VB中的多个对话框

Question

我遇到一个问题，当我尝试使用文件对话框的多个实例时，第一个对话框中的信息总是被第二个对话框中的选择覆盖。

我需要做的是：

1. 选择一个模板文件
2. 选择目标文件夹
3. 将模板文件另存为 .docm 文件。

发生的情况是第二次使用 application.FileDialog，fd 中的所有信息都丢失了，并被 fldr 中的条目覆盖。

每个宏只能有一个对话框对象吗？

Dim fd As FileDialog
Dim FileChosen As Integer
Dim FileName As String
Dim fldr As FileDialog
Dim fldrSelect As String


Dim i As Integer

Set fd = Application.FileDialog(msoFileDialogFilePicker)

    'use the standard title and filters, but change the

    'initial folder

    fd.InitialFileName = "H:\UpdatedSalesTemplates\"
    fd.InitialView = msoFileDialogViewList

    'allow multiple file selection
    fd.AllowMultiSelect = True

FileChosen = fd.Show

    If FileChosen = -1 Then

'Select the directory using a file dialog
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)

fldr.InitialView = msoFileDialogViewList
fldr.Title = "Select Destination"
fldr.AllowMultiSelect = False



fldrSelected = fldr.Show

'

Answer 1

微软说可能只有一个：“......每个宿主应用程序只能创建 FileDialog 对象的单个实例......”。

在任何情况下，只要您可以将所有相关信息（选择的路径、初始目录等）存储在（字符串）变量中，这不应该是一个严重的问题。

Answer 2

对于在一个宏/过程/用户表单中需要文件/文件夹选择器的这种情况，我使用定制的用户表单。看看你喜不喜欢。如下所示放置命令按钮和文本框

截屏

代码

注意：两个文本框 .Locked属性都True在设计时设置为，因此用户无法手动修改文本框。

Option Explicit

Dim Ret

'~~> Browse File
Private Sub CommandButton1_Click()
    Ret = Application.GetOpenFilename("Excel Files (*.xlsx), *.xlsx")
    If Ret <> False Then TextBox1.Text = Ret
End Sub

'~~> Browse Folder
Private Sub CommandButton2_Click()
    Ret = BrowseForFolder("C:\")
    If Ret <> False Then TextBox2.Text = Ret
End Sub

Function BrowseForFolder(Optional OpenAt As Variant) As Variant
    Dim ShellApp As Object

    Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "Please choose a folder", 0, OpenAt)

    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0

    Set ShellApp = Nothing

    Select Case Mid(BrowseForFolder, 2, 1)
    Case Is = ":"
        If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
    Case Is = "\"
        If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
    Case Else
        GoTo Invalid
    End Select

    Exit Function
Invalid:
     '~~> If it was determined that the selection was invalid, set to False
    BrowseForFolder = False
End Function