Refreshing a combobox list displaying subfolders/files RRS feed

  • Question

  • Hi,

    I have a form with a pair of combo boxes.  The first lists subfolders within a set location (Folder1 is the root, Folder2 contains the subfolders needed to be listed.  The second combobox lists the files contained within the subfolder selected in the first combo box.  I have a command button that opens the selected file, or if no file is selected, opens the folder in windows explorer.

    If the user adds a file or subfolder to the directory when the macro is already running, the new information doesn't show up in the combo box list.  The user has to close and reopen the macro to view the new information. 

    I want to add a command button to force a refresh of the data in the comboboxes but can't figure out how.  I'd appreciate any suggestions anyone might have.

    Please see the below code:

    Option Explicit
    Public objFolder, objSubFolder, objFiles As Object
    Public FolderLoc As String
    'This is where I want the user to be able to refresh the contents....
    Private Sub cmdRefresh_Click()
    MsgBox "Function not working yet.  To refresh, close the macro and reopen again."
    End Sub
    Private Sub UserForm_Initialize()
        lblTitle.Caption = "Please select the appropriate subfolder and/or file to open from the lists below:"
        FolderLoc = "\\Folder1\"
        Set objFolder = CreateObject("Scripting.FileSystemObject").GetFolder(FolderLoc)
        For Each objSubFolder In objFolder.subfolders
            VehicleListBox.AddItem objSubFolder.Name
        Next objSubFolder
    End Sub
    Private Sub VehicleListBox_Change()
        FolderLoc = "\\Folder1\Folder2\" & VehicleListBox.Value & "\"
        Set objFolder = CreateObject("Scripting.FileSystemObject").GetFolder(FolderLoc)
        For Each objFiles In objFolder.Files
            SOPlistbox.AddItem objFiles.Name
        Next objFiles
    End Sub
    Private Sub cmdOK_Click()
        Dim sFilePath As String
        Dim Shex As Object
        sFilePath = "\\Folder1\Folder2\" & VehicleListBox.Text & "\" & SOPlistbox.Text
        On Error Resume Next
        Set Shex = CreateObject("Shell.Application")
        Shex.Open (sFilePath)
        If Err.Number <> 0 Then _
            MsgBox "File not found. Make sure you have selected a file from the list."
    End Sub
    Private Sub cmdCancel_Click()
    End Sub
    Private Function Get_Matching_Filenames(ByVal sPath As String, _
        ByVal sPattern As String) As Variant
    '---Searches sPath and for files matching sPattern
    '   returns array of filenames or Null if no matches found
        Dim sFiles() As String
        Dim sFile As String, sMatch As String
        Dim lCnt As Long, i As Long
        If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
        On Error Resume Next
        sFile = Dir(sPath & "*.*", vbDirectory)
        Do While Len(sFile) > 0
            If Left(sFile, 1) <> "." Then
                If sFile Like sPattern Then
                    lCnt = lCnt + 1
                    ReDim Preserve sFiles(1 To lCnt)
                    sFiles(lCnt) = sFile
                End If
            End If
            sFile = Dir
        Get_Matching_Filenames = IIf(lCnt, sFiles(), Null)
    End Function

    Tuesday, August 1, 2017 9:19 AM

All replies