Multiple File Selector Dialog

[treva26]

I was looking for a way to do this for a long time, and the solutions I found were not very good.
Then I finally realised you could just select a folder, and return all the files in it!
Hopefully someone will find this useful.


Just put both these functions in a module:

Public Function BrowseFolder(szDialogTitle As String) As String
Dim x As Long
Dim bi As BROWSEINFO
Dim dwIList As Long
Dim szPath As String
Dim wPos As Integer
  
    With bi
        .hOwner = hWndAccessApp
        .lpszTitle = szDialogTitle
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With
    
    dwIList = SHBrowseForFolder(bi)
    szPath = Space$(512)
    x = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
    
    If x Then
        wPos = InStr(szPath, Chr(0))
        BrowseFolder = Left$(szPath, wPos - 1)
    Else
        BrowseFolder = vbNullString
    End If
End Function

Public Function GetAllFilesInDir(ByVal strDirPath As String) As Variant
    ' Loop through the directory specified in strDirPath and save each
    ' file name in an array, then return that array to the calling
    ' procedure.
    ' Return False if strDirPath is not a valid directory.
    Dim strTempName As String
    Dim varFiles() As Variant
    Dim lngFileCount As Long
    
    On Error GoTo GetAllFiles_Err
    
    ' Make sure that strDirPath ends with a "\" character.
    If Right$(strDirPath, 1) <> "\" Then
        strDirPath = strDirPath & "\"
    End If
    
    ' Make sure strDirPath is a directory.
    If GetAttr(strDirPath) = vbDirectory Then
        strTempName = Dir(strDirPath, vbDirectory)
        Do Until Len(strTempName) = 0
            ' Exclude ".", "..".
            If (strTempName <> ".") And (strTempName <> "..") Then
                ' Make sure we do not have a sub-directory name.
                If (GetAttr(strDirPath & strTempName) _
                    And vbDirectory) <> vbDirectory Then
                    ' Increase the size of the array
                    ' to accommodate the found filename
                    ' and add the filename to the array.
                    ReDim Preserve varFiles(lngFileCount)
                    varFiles(lngFileCount) = strTempName
                    lngFileCount = lngFileCount + 1
                End If
            End If
            ' Use the Dir function to find the next filename.
            strTempName = Dir()
        Loop
        ' Return the array of found files.
        GetAllFilesInDir = varFiles
    End If
GetAllFiles_End:
    Exit Function
GetAllFiles_Err:
    GetAllFilesInDir = False
    Resume GetAllFiles_End
End Function

And use this code in the OnClick event of a button on your form:

Private Sub AttachMultiple_Click()
On Error GoTo Test_Err

Dim varFileArray As Variant, lngI As Long, strDirName As String, fullpath1 As String, Size1
    Const NO_FILES_IN_DIR As Long = 9
    Const INVALID_DIR As Long = 13
    
strDirName = BrowseFolder("Select The Folder...")
varFileArray = GetAllFilesInDir(strDirName)

For lngI = 0 To UBound(varFileArray)
fullpath1 = strDirName & "\" & varFileArray(lngI)

'****
' Do what u want with each filename in here...
' Use this for just the filename: varFileArray(lngI)
' Or this for the fullpath name : fullpath1
'****

Next lngI

Me.Form.Refresh

Test_Err:
    Select Case Err.Number
        Case NO_FILES_IN_DIR
            MsgBox "The directory named '" & strDirName _
                & "' contains no files." 
        Case INVALID_DIR
            MsgBox "'" & strDirName & "' is not a valid directory." 
        Case 0
        Case Else
            MsgBox "Error #" & Err.Number & " - " & Err.Description 
    End Select
End Sub