Selecting multiple files from file control and importing

[tmort]

I'd like to be able to select multiple files from a file control and then import several files at once. I obtained some code awhile ago to select one file with a file control. I'm not familiar with all the things it does. I don't really see a setting for multple files but I do see a line:

Public Const OFN_ALLOWMULTISELECT As Long = &H200

That might be a setting for multiselect but I don't know what &H200 means or what I would use for "yes" (if that is what it is).

Can anyone help with this? Thanks.



Option Compare Database
Option Explicit

Private Const mcsDefaultFileFilter As String = "DEL File (*.DEL)|*.DEL|" & _
"Comma Delimited Files (*.csv)|*.csv|" & _
"Excel Files (*.xls)|*.xls|" & _
"All Files|*.*||"

Public Const OFN_ALLOWMULTISELECT As Long = &H200
Public Const OFN_CREATEPROMPT As Long = &H2000
Public Const OFN_ENABLEHOOK As Long = &H20
Public Const OFN_ENABLETEMPLATE As Long = &H40
Public Const OFN_ENABLETEMPLATEHANDLE As Long = &H80
Public Const OFN_EXPLORER As Long = &H80000
Public Const OFN_EXTENSIONDIFFERENT As Long = &H400
Public Const OFN_FILEMUSTEXIST As Long = &H1000
Public Const OFN_HIDEREADONLY As Long = &H4
Public Const OFN_LONGNAMES As Long = &H200000
Public Const OFN_NOCHANGEDIR As Long = &H8
Public Const OFN_NODEREFERENCELINKS As Long = &H100000
Public Const OFN_NOLONGNAMES As Long = &H40000
Public Const OFN_NONETWORKBUTTON As Long = &H20000
Public Const OFN_NOREADONLYRETURN As Long = &H8000& 'see comments
Public Const OFN_NOTESTFILECREATE As Long = &H10000
Public Const OFN_NOVALIDATE As Long = &H100
Public Const OFN_OVERWRITEPROMPT As Long = &H2
Public Const OFN_PATHMUSTEXIST As Long = &H800
Public Const OFN_READONLY As Long = &H1
Public Const OFN_SHAREAWARE As Long = &H4000
Public Const OFN_SHAREFALLTHROUGH As Long = 2
Public Const OFN_SHAREWARN As Long = 0
Public Const OFN_SHARENOWARN As Long = 1
Public Const OFN_SHOWHELP As Long = &H10
Public Const OFS_MAXPATHNAME As Long = 260

'OFS_FILE_OPEN_FLAGS and OFS_FILE_SAVE_FLAGS below
'are mine to save long statements; they're not
'a standard Win32 type.
Public Const OFS_FILE_OPEN_FLAGS = OFN_EXPLORER _
Or OFN_LONGNAMES _
Or OFN_CREATEPROMPT _
Or OFN_NODEREFERENCELINKS
Public Const OFS_FILE_OPEN_MULTI_FLAGS = OFN_EXPLORER _
Or OFN_LONGNAMES _
Or OFN_CREATEPROMPT _
Or OFN_NODEREFERENCELINKS _
Or OFN_ALLOWMULTISELECT
Public Const OFS_FILE_SAVE_FLAGS = OFN_EXPLORER _
Or OFN_LONGNAMES _
Or OFN_OVERWRITEPROMPT _
Or OFN_HIDEREADONLY


Private Const BIF_RETURNONLYFSDIRS = 1
Private Const MAX_PATH = 260

Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long

Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lparam As Long
iImage As Long
End Type
Private Type OPENFILENAME
lStructSize As Long
hWndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type


Public Function GetOpenFileNameGs( _
objForm As Form, _
Optional sInitialDir As String = "C:\", _
Optional lFlag As Long = 0, _
Optional sFileFilter As String = mcsDefaultFileFilter _
) As String
Dim OpenFile As OPENFILENAME
Dim lReturn As Long

OpenFile.lStructSize = Len(OpenFile)
OpenFile.hWndOwner = objForm.hWnd
OpenFile.hInstance = Application.hWndAccessApp
OpenFile.lpstrFilter = ReplaceG(sFileFilter, "|", vbNullChar)
OpenFile.nFilterIndex = 1
OpenFile.lpstrFile = String(257, 0)
OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
OpenFile.lpstrFileTitle = OpenFile.lpstrFile
OpenFile.nMaxFileTitle = OpenFile.nMaxFile
OpenFile.lpstrInitialDir = sInitialDir
OpenFile.lpstrTitle = "Open File"
OpenFile.Flags = lFlag
lReturn = GetOpenFileName(OpenFile)
If lReturn = 0 Then
GetOpenFileNameGs = ""
Else
GetOpenFileNameGs = CleanStringMs(OpenFile.lpstrFile & "")
End If
End Function

Private Function CleanStringMs(sInput As String) As String
Dim I As Long
CleanStringMs = ReplaceG(sInput, vbNullChar, "")
End Function

 

[Guus2005]

Use the built in Application.FileDialog. With some minor addjustments you can use this:

Public Function SelectOneFile(strCurDir As String, strDialogTitle As String, intFilter As FileType) As String
   ' SelectOneFile using the built-in Application.FileDialog.
   On Error GoTo Err_SelectOneFile

   Dim fd As FileDialog
   Dim varSelectedItem As Variant
   Dim strFile As String
   
   'Create a FileDialog object as a Folder Picker dialog box.
   Set fd = Application.FileDialog(msoFileDialogFilePicker)
   strFile = ""
   
   With fd
      .Title = strDialogTitle
      .ButtonName = "&Select"
      .InitialView = msoFileDialogViewDetails
      'Add a filter that includes MDB files and make it the first item in the list.
      .Filters.Clear
      
      If intFilter = FileType.Excel Then
        .Filters.Add "Excel spreadsheet", "*.xls", 1
      Else
        .Filters.Add "Access databases", "*.mdb", 1
      End If
      
      .Filters.Add "All files", "*.*", 2
      'Sets the initial file filter to number 1.
      .FilterIndex = 1
      If .Show = -1 Then
         For Each varSelectedItem In .SelectedItems
            strFile = strFile & ", " & varSelectedItem
         Next varSelectedItem
      Else
         strFile = ""
      End If
   End With

    SelectOneFile = Mid$(strFile, 3)

Exit_SelectOneFile:
   Set fd = Nothing
   Exit Function

Err_SelectOneFile:
   ErrorProc Err, Error$, "SelectOneFile", "basFileDialog"
   Resume Exit_SelectOneFile

End Function