AllowMultiSelect

[magmike]

I recently received help here on bringing up a file browser window for
import and allowing for the selection of multiple files for import.
Thanks to all of you who helped!

When I enable AllowMultiSelect (=H200) it brings up the old school
file browser window where the file names are truncated with ~1 at the
end. Is there a way to use the more modern file browser window for
multiselect?

Thanks in advance for your help!
magmike

 

[Mark Andrews]

I use this code:

Public Function GetMultipleExcelFiles(Optional varDirectory As Variant,
Optional varTitleForDialog As Variant) As Variant
' This function opens a filedialog for selecting one or multiple Excel files
' See TestIT for ways of calling this function

Dim strFilter As String
Dim lngFlags As Long
Dim varFileName As Variant
Dim varFileList() As String

' Specify that the chosen file must already exist,
' don't change directories when you're done
' Also, don't bother displaying
' the read-only box. It'll only confuse people.
lngFlags = ahtOFN_FILEMUSTEXIST Or ahtOFN_HIDEREADONLY Or
ahtOFN_NOCHANGEDIR Or ahtOFN_ALLOWMULTISELECT Or ahtOFN_EXPLORER
If IsMissing(varDirectory) Then
varDirectory = ""
End If
If IsMissing(varTitleForDialog) Then
varTitleForDialog = ""
End If

'Note: if you need a different filter I recommend making another
function
strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.XLS)", "*.XLS*")

varFileName = ahtCommonFileOpenSave(OpenFile:=True, _
InitialDir:=varDirectory, _
Filter:=strFilter, _
Flags:=lngFlags, _
DialogTitle:=varTitleForDialog)

If Not IsNull(varFileName) Then
varFileName = TrimNull(varFileName)
End If

GetMultipleExcelFiles = varFileName

End Function


Here are the constants
Global Const ahtOFN_READONLY = &H1
Global Const ahtOFN_OVERWRITEPROMPT = &H2
Global Const ahtOFN_HIDEREADONLY = &H4
Global Const ahtOFN_NOCHANGEDIR = &H8
Global Const ahtOFN_SHOWHELP = &H10
' You won't use these.
'Global Const ahtOFN_ENABLEHOOK = &H20
'Global Const ahtOFN_ENABLETEMPLATE = &H40
'Global Const ahtOFN_ENABLETEMPLATEHANDLE = &H80
Global Const ahtOFN_NOVALIDATE = &H100
Global Const ahtOFN_ALLOWMULTISELECT = &H200
Global Const ahtOFN_EXTENSIONDIFFERENT = &H400
Global Const ahtOFN_PATHMUSTEXIST = &H800
Global Const ahtOFN_FILEMUSTEXIST = &H1000
Global Const ahtOFN_CREATEPROMPT = &H2000
Global Const ahtOFN_SHAREAWARE = &H4000
Global Const ahtOFN_NOREADONLYRETURN = &H8000
Global Const ahtOFN_NOTESTFILECREATE = &H10000
Global Const ahtOFN_NONETWORKBUTTON = &H20000
Global Const ahtOFN_NOLONGNAMES = &H40000
' New for Windows 95
Global Const ahtOFN_EXPLORER = &H80000
Global Const ahtOFN_NODEREFERENCELINKS = &H100000
Global Const ahtOFN_LONGNAMES = &H200000

Hope that helps you figure it out,
Mark Andrews
RPT Software
http://www.rptsoftware.com
http://www.donationmanagementsoftware.com

 

[magmike]

I use this code:

Public Function GetMultipleExcelFiles(Optional varDirectory As Variant,
Optional varTitleForDialog As Variant) As Variant
' This function opens a filedialog for selecting one or multiple Excel files
' See TestIT for ways of calling this function

    Dim strFilter As String
    Dim lngFlags As Long
    Dim varFileName As Variant
    Dim varFileList() As String

    ' Specify that the chosen file must already exist,
    ' don't change directories when you're done
    ' Also, don't bother displaying
    ' the read-only box. It'll only confuse people.
    lngFlags = ahtOFN_FILEMUSTEXIST Or ahtOFN_HIDEREADONLY Or
ahtOFN_NOCHANGEDIR Or ahtOFN_ALLOWMULTISELECT Or ahtOFN_EXPLORER
    If IsMissing(varDirectory) Then
        varDirectory = ""
    End If
    If IsMissing(varTitleForDialog) Then
        varTitleForDialog = ""
    End If

    'Note: if you need a different filter I recommend making another
function
    strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.XLS)", "*.XLS*")

    varFileName = ahtCommonFileOpenSave(OpenFile:=True, _
                  InitialDir:=varDirectory, _
                  Filter:=strFilter, _
                  Flags:=lngFlags, _
                  DialogTitle:=varTitleForDialog)

    If Not IsNull(varFileName) Then
        varFileName = TrimNull(varFileName)
    End If

    GetMultipleExcelFiles = varFileName

End Function

Here are the constants
Global Const ahtOFN_READONLY = &H1
Global Const ahtOFN_OVERWRITEPROMPT = &H2
Global Const ahtOFN_HIDEREADONLY = &H4
Global Const ahtOFN_NOCHANGEDIR = &H8
Global Const ahtOFN_SHOWHELP = &H10
' You won't use these.
'Global Const ahtOFN_ENABLEHOOK = &H20
'Global Const ahtOFN_ENABLETEMPLATE = &H40
'Global Const ahtOFN_ENABLETEMPLATEHANDLE = &H80
Global Const ahtOFN_NOVALIDATE = &H100
Global Const ahtOFN_ALLOWMULTISELECT = &H200
Global Const ahtOFN_EXTENSIONDIFFERENT = &H400
Global Const ahtOFN_PATHMUSTEXIST = &H800
Global Const ahtOFN_FILEMUSTEXIST = &H1000
Global Const ahtOFN_CREATEPROMPT = &H2000
Global Const ahtOFN_SHAREAWARE = &H4000
Global Const ahtOFN_NOREADONLYRETURN = &H8000
Global Const ahtOFN_NOTESTFILECREATE = &H10000
Global Const ahtOFN_NONETWORKBUTTON = &H20000
Global Const ahtOFN_NOLONGNAMES = &H40000
' New for Windows 95
Global Const ahtOFN_EXPLORER = &H80000
Global Const ahtOFN_NODEREFERENCELINKS = &H100000
Global Const ahtOFN_LONGNAMES = &H200000

Hope that helps you figure it out,
Mark Andrews
RPT Softwarehttp://www.rptsoftware.comhttp://www.donationmanagementsoftware.com

Once you open the dialog for selecting the files, how would you use
the selections with a TransferText command? I am importing text files
into tables. That is another issue I have. My code ends up sending a
value like "file1.txt file2.txt file3.txt" and I just get an error
saying it is not a valid file.

 

[Douglas J. Steele]

See whether my article at http://my.advisor.com/doc/18505 helps.

--
Doug Steele, Microsoft Access MVP
http://www.AccessMVP.com/DJSteele
(no e-mails, please!)

I use this code:

Public Function GetMultipleExcelFiles(Optional varDirectory As Variant,
Optional varTitleForDialog As Variant) As Variant
' This function opens a filedialog for selecting one or multiple Excel
files
' See TestIT for ways of calling this function

Dim strFilter As String
Dim lngFlags As Long
Dim varFileName As Variant
Dim varFileList() As String

' Specify that the chosen file must already exist,
' don't change directories when you're done
' Also, don't bother displaying
' the read-only box. It'll only confuse people.
lngFlags = ahtOFN_FILEMUSTEXIST Or ahtOFN_HIDEREADONLY Or
ahtOFN_NOCHANGEDIR Or ahtOFN_ALLOWMULTISELECT Or ahtOFN_EXPLORER
If IsMissing(varDirectory) Then
varDirectory = ""
End If
If IsMissing(varTitleForDialog) Then
varTitleForDialog = ""
End If

'Note: if you need a different filter I recommend making another
function
strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.XLS)", "*.XLS*")

varFileName = ahtCommonFileOpenSave(OpenFile:=True, _
InitialDir:=varDirectory, _
Filter:=strFilter, _
Flags:=lngFlags, _
DialogTitle:=varTitleForDialog)

If Not IsNull(varFileName) Then
varFileName = TrimNull(varFileName)
End If

GetMultipleExcelFiles = varFileName

End Function

Here are the constants
Global Const ahtOFN_READONLY = &H1
Global Const ahtOFN_OVERWRITEPROMPT = &H2
Global Const ahtOFN_HIDEREADONLY = &H4
Global Const ahtOFN_NOCHANGEDIR = &H8
Global Const ahtOFN_SHOWHELP = &H10
' You won't use these.
'Global Const ahtOFN_ENABLEHOOK = &H20
'Global Const ahtOFN_ENABLETEMPLATE = &H40
'Global Const ahtOFN_ENABLETEMPLATEHANDLE = &H80
Global Const ahtOFN_NOVALIDATE = &H100
Global Const ahtOFN_ALLOWMULTISELECT = &H200
Global Const ahtOFN_EXTENSIONDIFFERENT = &H400
Global Const ahtOFN_PATHMUSTEXIST = &H800
Global Const ahtOFN_FILEMUSTEXIST = &H1000
Global Const ahtOFN_CREATEPROMPT = &H2000
Global Const ahtOFN_SHAREAWARE = &H4000
Global Const ahtOFN_NOREADONLYRETURN = &H8000
Global Const ahtOFN_NOTESTFILECREATE = &H10000
Global Const ahtOFN_NONETWORKBUTTON = &H20000
Global Const ahtOFN_NOLONGNAMES = &H40000
' New for Windows 95
Global Const ahtOFN_EXPLORER = &H80000
Global Const ahtOFN_NODEREFERENCELINKS = &H100000
Global Const ahtOFN_LONGNAMES = &H200000

Hope that helps you figure it out,
Mark Andrews
RPT
Softwarehttp://www.rptsoftware.comhttp://www.donationmanagementsoftware.com

Once you open the dialog for selecting the files, how would you use
the selections with a TransferText command? I am importing text files
into tables. That is another issue I have. My code ends up sending a
value like "file1.txt file2.txt file3.txt" and I just get an error
saying it is not a valid file.

 

[Mark Andrews]

Something like this or look at Doug's article:

'get single file or multiple files (by using ctrl click to select
multiple) and import them in tblImportDiscrepancy
strFiles = GetMultipleExcelFiles(CurrentDBDir, "Ctrl-Click for
Multi-Select")
astrFiles = Split(strFiles, vbNullChar)
If UBound(astrFiles) < LBound(astrFiles) Then
MsgBox "No files were selected"
ElseIf UBound(astrFiles) = LBound(astrFiles) Then
'MsgBox "One file was selected. File (with path) is: " &
astrFiles(LBound(astrFiles))
Call ImportASingleLogFile(astrFiles(LBound(astrFiles)))
Else
J = LBound(astrFiles)
' Debug.Print UBound(astrFiles) & " files were selected in folder ";
astrFiles(J)
For i = J + 1 To UBound(astrFiles)
' MsgBox astrFiles(I)
Call ImportASingleLogFile(astrFiles(J) & "\" & astrFiles(i))
Next i
End If


Private Sub ImportASingleLogFile(strfilename As String)

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12,
"tblImportDiscrepancy", strfilename, True

End Sub