ComboBox dropdown select various window folders|VBA & Macros|Excel Forum|My Online Training Hub

Hi everyone, it's been a while, sorry, a lot of work

Hi Steven 😉

you want to add the name of files that are found in a folder, to a combobox, right?

example:

code in userform: (userform with command button & combobox)

Option Explicit

Private Sub CommandButton4_Click()

Call allFilesInFolder ' (MACROS IN MODULE)

End Sub

code in module

Option Explicit

Public Sub allFilesInFolder()

Dim checkForFolder$

checkForFolder = checkDir
If checkForFolder = "" Then MsgBox "Critical error, unable to complete!", vbCritical, "Critical error": Exit Sub

listAllFilesInFolder checkForFolder, True

End Sub

Private Sub listAllFilesInFolder(folderName As String, subfolderName As Boolean)

Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim str$

Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(folderName)

UserForm1.ComboBox1.Clear

For Each FileItem In SourceFolder.Files
     With UserForm1.ComboBox1
         ''--- file name and extension
         ' str = FileItem.Name
         ' .AddItem FileItem.Name
         ''--- only file name & remove extension
         str = removeLastOne(FileItem.Name)
         .AddItem str
     End With
Next FileItem

If subfolderName Then
     For Each SubFolder In SourceFolder.SubFolders
         listAllFilesInFolder SubFolder.Path, True
     Next SubFolder
End If

If Not SourceFolder Is Nothing Then Set SourceFolder = Nothing
If Not FSO Is Nothing Then Set FSO = Nothing

End Sub

Private Function checkDir()

Dim objShell, xFolder, xPath, xCheck

Set objShell = CreateObject("Shell.Application")
Set xFolder = objShell.BrowseForFolder(&H0&, "Please confirm: Select the folder with the files!", &H1&)

On Error Resume Next
xPath = xFolder.ParentFolder.ParseName(xFolder.Title).Path & ""

If xFolder.Title = "Bureau" Then
     xPath = "C:WindowsBureau"
End If

If xFolder.Title = "" Then
     xPath = ""
End If

xCheck = InStr(xFolder.Title, ":")

If xCheck > 0 Then
     xPath = VBA.Mid(xFolder.Title, xCheck - 1, 2) & ""
End If

checkDir = xPath

If Not objShell Is Nothing Then Set objShell = Nothing
If Not xFolder Is Nothing Then Set xFolder = Nothing

End Function

Private Function removeLastOne(str As String) As String

Const character As String = "."
Dim Position As Long

If VBA.InStr(str, character) = 0 Then
     removeLastOne = str
     Exit Function
End If

Position = VBA.InStrRev(str, character)
removeLastOne = VBA.Mid(str, 1, Position - 1)

End Function

Regards Steven

Miguel