Excel VBA与Microstation文件夹搜索

Question

我目前在其中一个宏中有这段代码可供使用。它位于一个按钮下，用于浏览要查看的文件夹，它将获取.DGNs并将它们添加到列表框中。

我不太明白代码完全是希望有人能给我一个快速的运行。另外，代码只查看选定的.DGNs文件夹，我希望它也能查看子文件夹，这可能吗？

Dim myFSO As New Scripting.FileSystemObject
    Dim myFolder As Scripting.Folder
    Dim myFile As Scripting.File
    Dim myShell As New Shell32.Shell
    Dim myRootFolder As Shell32.Folder3
    Set myRootFolder = myShell.BrowseForFolder(0, "Pick", 0)
    If myRootFolder Is Nothing Then Exit Sub

    Set myFolder = myFSO.GetFolder(myRootFolder.Self.path)
    txtCurrentFolder.Text = myRootFolder.Self.path
    lstFilesInFolder.Clear
    For Each myFile In myFolder.Files
        Select Case UCase(Right(myFile.Name, 3))
            Case "DGN"
                If IsFileIn(myFile.path, lstFilesToProcess) = False Then
                    lstFilesInFolder.AddItem myFile.path
                End If
        End Select
    Next

Answer 1

代码显示一个GUI来选择一个文件夹，然后迭代该文件夹的子文件，测试它们的名字是否以DGN结尾，如果是，那么测试该文件是否已经在某个集合(lstFilesInFolder)中，如果没有，则添加它。

我认为这种方法看起来有点复杂(选择一个文件夹可以不通过Application.FileDialog使用Shell就可以完成)，没有其他代码，我无法判断某些部分(比如测试lstFilesInFolder等)，我个人不喜欢使用myX作为变量命名约定。然而，它做的似乎是它的本意。

我喜欢基于堆栈/队列的“递归”方法，而不是实际的递归调用。

将代码转换为子文件夹中的代码的一个例子是：(请参阅我添加的行中的注释)。

Dim myFSO As Scripting.FileSystemObject 'changed from late-binding
Set myFSO = New Scripting.FileSystemObject 
Dim folderQueue As Collection 'queue
Set folderQueue = New Collection 'instantiate

    Dim myFolder As Scripting.Folder
    Dim subfolder As Scripting.Folder 'var for enumerating subfolders
    Dim myFile As Scripting.File
    Dim myShell As New Shell32.Shell
    Dim myRootFolder As Shell32.Folder3
    Set myRootFolder = myShell.BrowseForFolder(0, "Pick", 0)
    If myRootFolder Is Nothing Then Exit Sub

    folderQueue.Add myFSO.GetFolder(myRootFolder.Self.path) 'enqueue

Do While folderQueue.Count > 0 ''recursive' loop
    Set myFolder = folderQueue(1) 'get next folder
    folderQueue.Remove 1 'dequeue
    txtCurrentFolder.Text = myRootFolder.Self.path
    lstFilesInFolder.Clear
    For Each subfolder in myFolder.SubFolders 'loop through subfolders adding for processing
        folderQueue.Add subfolder 'enqueue
    Next
    For Each myFile In myFolder.Files
        Select Case UCase(Right(myFile.Name, 3))
            Case "DGN"
                If IsFileIn(myFile.path, lstFilesToProcess) = False Then
                    lstFilesInFolder.AddItem myFile.path
                End If
        End Select
    Next
Loop

作为最后一点，有时将对脚本库的特定版本(静态类型很好)的引用转换为在向其他用户发布之前使用CreateObject("Scripting.FileSystemObject")，因为引用的使用有时会引起问题。