Vba 使用FileDialog应用程序的问题

我有一些代码，我正在努力改进，但有一些问题

代码当前为：

    Sub TestListFilesInFolder()
'Workbooks.Add ' create a new workbook for the file list
' add headers

Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker) ' Tried using a FileDialog Application  but had no luck

With Range("A1")
    .Formula = "Folder contents:"
    .Font.Bold = True
    .Font.Size = 12
End With
Range("A3").Formula = "Old File Path:"
Range("B3").Formula = "File Type:"
Range("C3").Formula = "File Name:"
Range("D3").Formula = "New File Path:"
Range("A3:H3").Font.Bold = True
ListFilesInFolder "L:\Pictures\A B C\B526 GROUP", True
' ListFilesInFolder fd, True ' I tried replacing the above line with this line but get an error

' list all files included subfolders
 End Sub

第5行和第6行是我在其中添加的一部分，我试图打开一个文件对话框，用户可以在其中选择代码要处理的文件夹

此外，底部起始ListFileInfolder附近的注释掉的行是我尝试插入以替换其上方的行的行

下一位代码的开头是：

   Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)

因此，它使用在第一个子文件夹中定义的文件夹及其子文件夹

在此方面的任何帮助都将不胜感激

问候,

---

Sam

确保您选择了适当的参考：

按Alt+F11打开VB编辑器。在该窗口中，选择菜单项工具->参考…，然后向下查看Microsoft Office XXX对象库的列表 Access 2003是11.0，Access 2002是10.0；9.0用于Access 2000，8.0用于Access 97--选择正确的一个。
在该引用旁边的框中打勾，然后关闭对话框

或者，使用实际值，而不是mso值

msoFileDialogOpen=1
msoFileDialogSaveAs=2
msoFileDialogFilePicker=3
msoFileDialogFolderPicker=4

---

您正在将

fd

作为第一个参数传递给

ListFilesInFolder

sub。此sub接受

String

作为第一个参数，nota

FileDialog

下面是一些示例代码，当执行这些代码时，将打开一个文件对话框，让用户选择一个文件夹。一旦选中，它将把文件夹的路径打印到

B2

。如果未选择任何文件夹（例如对话框关闭或取消），

B2

将包含文本

未选择任何项目

我认为你应该创建一个新的工作簿并使用这个宏。设置一个断点并遍历它，看看它实际上在做什么。然后您可以修改它，使其满足您的特定需求

Public Sub SelectExportDestinationPath()
    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
            sItem = "No item selected"
        Else
            sItem = .SelectedItems(1)
        End If
    End With

    'if trailing slash is not found, add it
    If Len(sItem) > 0 And InStr(Len(sItem), sItem, Application.PathSeparator, vbCompareText) = 0 Then
        sItem = sItem & Application.PathSeparator
    End If

    Sheet1.Cells(2, 2).Value = sItem

    Set fldr = Nothing
End Sub

Public子选择ExportDestinationPath（）
Dim fldr As FILE对话框
以字符串形式显示
设置fldr=Application.FileDialog（msoFileDialogFolderPicker）
与fldr
.Title=“选择一个文件夹”
.AllowMultiSelect=False
.InitialFileName=strPath
如果.Show-1那么
sItem=“未选择任何项目”
其他的
sItem=.SelectedItems（1）
如果结束
以
'如果未找到尾随斜杠，请添加它
如果Len（sItem）>0且InStr（Len（sItem）、sItem、Application.pathselector、vbCompareText）=0，则
sItem=sItem&Application.PathSeparator
如果结束
表1.单元格（2，2）.值=sItem
设置fldr=无
端接头

没问题-很乐意帮忙。祝你的项目顺利完成。