Excel VBA with Microstation Folder Search



我目前在其中一个宏中具有此代码以进行工作。它位于用于浏览要查看的文件夹的按钮下方,它将获得.DGN 并将其添加到列表框中。

我不太完全理解代码,希望有人可以快速浏览一下。此外,代码仅查看 的选定文件夹。DGN,我希望它也查看子文件夹,这可能吗?

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

该代码显示了一个用于选择文件夹的 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"),因为使用引用有时会导致问题。

最新更新