Select and Import Multiple files to a Table through Open/Save Dialog Box

[PhenomHTPC]

Hi Boblarson,
I kept this new thread in the Macros section if thats ok. Looking forward to seeing what you suggest. I am also using Access 2010, so I hope there are no problems. Here is my original question:

I am currently working in a data base that I have created, which uses the same function of the open/save dialog box to import files into a database, and it is based off of the code from the link you have placed in the previous posts. I am able to import one file at a time perfectly, but I am wondering how to import multple files at once, which will all append into the same table. In the code there is a line to select multiple files, but the docmd.transfertext no longer works. Is there a way to have the multiple files imported besides re-running this code for every file I would neet?

Here is the code I am currently using as well.

Thanks for the quick response,

~John

Dim strFilter As String
    Dim lngFlags As Long
 
    'strFilter = ahtAddFilterItem(strFilter, "Access Files (*.mda, *.mdb)", _
                    "*.MDA;*.MDB")
    'strFilter = ahtAddFilterItem(strFilter, "dBASE Files (*.dbf)", "*.DBF")
    'strFilter = ahtAddFilterItem(strFilter, "Text Files (*.txt)", "*.TXT")
    strFilter = ahtAddFilterItem(strFilter, "All Files (*.*)", "*.*")
    ' Uncomment this line to try the example
    ' allowing multiple file names:
    lngFlags = ahtOFN_ALLOWMULTISELECT Or ahtOFN_EXPLORER
    Dim result As Variant
    result = ahtCommonFileOpenSave(InitialDir:="I:\CI00710\Commissions\Smart Office\Golden Rule", _
        Filter:=strFilter, FilterIndex:=3, Flags:=lngFlags, _
        DialogTitle:="Hello! Open Me!")
 
 
    If lngFlags And ahtOFN_ALLOWMULTISELECT Then
        If IsArray(result) Then
            Dim i As Integer
            For i = 0 To UBound(result)
                MsgBox result(i)
            Next i
        Else
            MsgBox result
        End If
    Else
        MsgBox result
    End If
    ' Since you passed in a variable for lngFlags,
    ' the function places the output flags value in the variable.
    Debug.Print Hex(lngFlags)
 
 
 DoCmd.TransferText acImportDelim, "", "tblgoldenruledata", result, True, ""

 

[boblarson]

Actually should be in the Modules and VBA category (so I moved it there).

Here's code which should do what you want, without that API and without having to set a reference.

    Dim fd     As Object
    Dim strFilter As String
    Dim lngItems As Long
 
    Const msoFileDialogOpen As Long = 3
    Const msoFileDialogViewDetails As Long = 2
 
    Set fd = FileDialog(msoFileDialogOpen)
 
    With fd
        .AllowMultiSelect = True
        .InitialView = msoFileDialogViewDetails
        .InitialFileName = "I:\CI00710\Commissions\Smart Office\Golden Rule"
        .Title = "Hello! Open Me!"
        .Filters.Clear
        .Filters.Add "All Files", "*.*"
        .Show
    End With
 
    For lngItems = 1 To fd.SelectedItems.Count
        ' Debug.Print fd.SelectedItems(lngItems)
        DoCmd.TransferText acImportDelim, "", "tblgoldenruledata", fd.SelectedItems(lngItems), True, ""
    Next

 

[boblarson]

Oops, I had to modify the Filters line in the code above to clear them first and then also change what I had to what it needed to really be.

 

[PhenomHTPC]

Looks good! I will try it first thing in the morning at work!

 

[PhenomHTPC]

Works like a Charm! Your help is much appreciated! Thanks again.

~John