Search code examples
vbaexcelmicrostation

Excel VBA with Microstation Folder Search


i currently have this code in one of the macros for work. It is located under a button for browsing which folder to look into, and it will get the .DGNs and add them to a listbox.

I don't quite understand the code fully was hoping someone can give me a quick run down. Also, the code only looks at the selected folder for .DGNs, i want it to look into sub folders as well, is that possible?

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

Solution

  • The code shows a GUI to select a folder, then iterates through the folder's child files testing if their names end in DGN and if so then testing if the file is already in some collection (lstFilesInFolder) and if not then adding it.

    I think the approach seems a little complicated (picking a folder(s) can be done simply without using the Shell through Application.FileDialog) and I cannot judge some parts (like is it necessary to test lstFilesInFolder etc) without the rest of the code, and just personally I dislike the use of myX as a variable naming convention. Nevertheless, it does what it seems it is meant to do.

    I like a stack/queue based approach to 'recursion' rather than actual recursive calls.

    An example of converting your code to something that looks in subfolders as well is: (see comments on my added lines)

    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
    

    As a final point, it is sometimes considered good practice to switch the use of a reference to a specific version of the Scripting library (nice for static typing) to using e.g. CreateObject("Scripting.FileSystemObject") before releasing to other users as the use of a reference can sometimes cause issues.