Import multiple excel workbooks into one access table

[mlrucci]

Good afternoon, I have currently written code to select an excel workbook using file picker and import selected columns within that workbook using a picker. Works great. I am now trying to select multiple workbooks using the file picker so that I do not need to repeat the same process over and over. I am struggling with getting all the workbooks to import. It will only import the first workbook selected. Ideas? Below is my code.

Private Sub cmdAS_PS_Click()
Dim dbs             As DAO.Database
Dim strXls          As String
Dim SelectedFile    As String
Dim FilePicker      As FileDialog
Dim SQLdelete       As String
Set dbs = CurrentDb
Set FilePicker = Application.FileDialog(msoFileDialogFilePicker)


On Error GoTo Err_Display
    FilePicker.AllowMultiSelect = True
    FilePicker.Filters.Add "Excel", "*.xls*", 1
    FilePicker.InitialFileName = "C:\Users\"
    FilePicker.Title = "Please Select the Excel Data..."
    FilePicker.Show
    If FilePicker.SelectedItems.Count <> 0 Then
        CurrentDb.Execute "DELETE * FROM tblImportAS_CC", dbFailOnError
        CurrentDb.Execute "DELETE * FROM tblAppImportAS_CC", dbFailOnError
        SelectedFile = FilePicker.SelectedItems(1)
        DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "tblImportAS_CC", SelectedFile, True, "Worksheet!L:P"
        DoCmd.OpenForm "frmImportAS_CC", acViewNormal, acEdit
        MsgBox ("The data has been successfully loaded")
        Else
            Call MsgBox("No file was selected.")
    End If
Err_Exit:
    Exit Sub
Err_Display:
    MsgBox "An error has occurred.  Please review the workbook you have selected.  Either you choose the wrong worksheet or there is/are extra data cells not recognized. " & Err.Number & " " & Err.Description
    Resume Err_Exit
End Sub

[Gicu]

You need to add a loop to your code - see example here:https://docs.microsoft.com/en-us/off...lowmultiselect

Cheers,

[mlrucci]

Thank you for the idea. I haven't worked with loops before, so did a little research and looked at the link you provided. When I run the code, my system freezes. Can you peak at this and give suggestions please. In the end, I would like the work book to open after import

Private Sub cmdAS_PS_Click()
Dim FilePicker  As FileDialog
Dim varfile     As Variant 'variant type variable that will store the selected file path
Dim xlApp       As Excel.Application 'the excel application
Dim xlWb        As Excel.Workbook 'the excel workbook reference that will point to the opened workbook
Dim xlWs        As Excel.Worksheet 'the excel worksheet with data
Dim intLine     As Long 'line counter
Dim SelectedFile As String
Dim dbs         As DAO.Database
Set dbs = CurrentDb
Set FilePicker = Application.FileDialog(msoFileDialogFilePicker)
        
    CurrentDb.Execute "DELETE * FROM tblAppImportAS_CC", dbFailOnError
    CurrentDb.Execute "DELETE * FROM tblImportAS_CC", dbFailOnError 'clean the existing database table
    FilePicker.AllowMultiSelect = True
    FilePicker.Filters.Add "Excel", "*.xls*", 1
    FilePicker.InitialFileName = "C:\Users\"
    FilePicker.Title = "Please Select the Excel Data..."
    FilePicker.Show
        If FilePicker.SelectedItems.Count > 0 Then
            SelectedFile = FilePicker.SelectedItems(1)
            Do
                DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "tblImportAS_PS", SelectedFile, True, "Worksheet!L:P"
                
            Loop Until FilePicker.SelectedItems.Count = 0
                'Once the loop stops, close the open workbook, quit excel, and clean the memory references to the created objects
                Else 'if no file was selected
                Call MsgBox("No file was selected.") 'open message box
        End If
    Exit Sub
cmdImportExcel_Click_err:
    Select Case Err.Number
        Case Else
            Call MsgBox(Err.Number & "-" & Err.Description, vbCritical + vbOKOnly, "System Error …")
    End Select
End Sub

[ssanfu]

You might also check out Ken Snell's site Ken's ACCESS Examples and Information for Working With EXCEL Workbook Files

[Gicu]

Can you please try this:

Private Sub cmdAS_PS_Click()
Dim FilePicker  As FileDialog
Dim varfile     As Variant 'variant type variable that will store the selected file path
Dim xlApp       As Excel.Application 'the excel application
Dim xlWb        As Excel.Workbook 'the excel workbook reference that will point to the opened workbook
Dim xlWs        As Excel.Worksheet 'the excel worksheet with data
Dim intLine     As Long 'line counter
Dim SelectedFile As String
Dim dbs         As DAO.Database
Dim vrtSelectedItem As Variant 

Set dbs = CurrentDb
Set FilePicker = Application.FileDialog(msoFileDialogFilePicker)
        
    CurrentDb.Execute "DELETE * FROM tblAppImportAS_CC", dbFailOnError
    CurrentDb.Execute "DELETE * FROM tblImportAS_CC", dbFailOnError 'clean the existing database table
    


    FilePicker.AllowMultiSelect = True
    FilePicker.Filters.Add "Excel", "*.xls*", 1
    FilePicker.InitialFileName = "C:\Users\"
    FilePicker.Title = "Please Select the Excel Data..."
    
IF FilePicker.Show=-1 Then

        'If FilePicker.SelectedItems.Count > 0 Then
            'SelectedFile = FilePicker.SelectedItems(1)
            'Do
               ' DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "tblImportAS_PS", SelectedFile, True, "Worksheet!L:P"
                
            'Loop Until FilePicker.SelectedItems.Count = 0
                'Once the loop stops, close the open workbook, quit excel, and clean the memory references to the created objects
                'Else 'if no file was selected
                'Call MsgBox("No file was selected.") 'open message box
        'End If
    'Step through each string in the FileDialogSelectedItems collection. 
     For Each vrtSelectedItem In FilePicker.SelectedItems 
 
     'vrtSelectedItem is a String that contains the path of each selected item. 
     'You can use any file I/O functions that you want to work with this path. 
     'This example displays the path in a message box. 
     'MsgBox "Selected item's path: " & vrtSelectedItem 
          DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "tblImportAS_PS", vrtSelectedItem , True, "Worksheet!L:P"
        'OPEN WORKBOOK 
        Appplication.FollowHyperlink vrtSelectedItem 
     Next 
 'If the user presses Cancel... 
Else 
    Call MsgBox("No file was selected.") 'open message box
End If 

    Exit Sub
cmdImportExcel_Click_err:
    Select Case Err.Number
        Case Else
            Call MsgBox(Err.Number & "-" & Err.Description, vbCritical + vbOKOnly, "System Error …")
    End Select
End Sub

[mlrucci]

Thank you so very much, made some very minor tweaks to make it work. The only item I am struggling with is the line Appplication.FollowHyperlink vrtSelectedItem I keep coming up with the error "Compile error: Variable not defined." I tried to define with
Dim xlApp as Excel.Application without success. When I remove that line, it works great except opening the selected excel spreadsheet after import.

Private Sub cmdAS_PS_Click()
Dim FilePicker  As FileDialog
Dim varfile     As Variant 'variant type variable that will store the selected file path
Dim xlApp       As Excel.Application 'the excel application
Dim xlWb        As Excel.Workbook 'the excel workbook reference that will point to the opened workbook
Dim xlWs        As Excel.Worksheet 'the excel worksheet with data
Dim intLine     As Long 'line counter
Dim SelectedFile As String
Dim dbs         As DAO.Database
Dim vrtSelectedItem As Variant
Set dbs = CurrentDb
Set FilePicker = Application.FileDialog(msoFileDialogFilePicker)
        
CurrentDb.Execute "DELETE * FROM tblAppImportAS_CC", dbFailOnError
CurrentDb.Execute "DELETE * FROM tblImportAS_CC", dbFailOnError 'clean the existing database table
FilePicker.AllowMultiSelect = True
FilePicker.Filters.Add "Excel", "*.xls*", 1
FilePicker.InitialFileName = "C:\Users\"
FilePicker.Title = "Please Select the Excel Data..."
    
    If FilePicker.Show = -1 Then
        'Step through each string in the FileDialogSelectedItems collection.
        For Each vrtSelectedItem In FilePicker.SelectedItems
        'vrtSelectedItem is a String that contains the path of each selected item.
        'You can use any file I/O functions that you want to work with this path.
        'This example displays the path in a message box.
        'MsgBox "Selected item's path: " & vrtSelectedItem
        DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "tblImportAS_CC", vrtSelectedItem, True, "Worksheet!L:P"
        'OPEN WORKBOOK
        Appplication.FollowHyperlink vrtSelectedItem
    Next
        DoCmd.OpenForm "frmImportAS_CC", acViewNormal, acEdit
        MsgBox ("The data has been successfully loaded")
        'If the user presses Cancel...
        Else
            Call MsgBox("No file was selected.") 'open message box
    End If
    Exit Sub
cmdImportExcel_Click_err:
    Select Case Err.Number
        Case Else
            Call MsgBox(Err.Number & "-" & Err.Description, vbCritical + vbOKOnly, "System Error …")
    End Select
End Sub

[Gicu]

Sorry for this, I wrote this in Notepad and I have three p's in Application

  Appplication.FollowHyperlink vrtSelectedItem

Cheers,

[mlrucci]

Wow, what’s even worse is that I missed it and wrote about it. Lol. Really appreciate the help!

[Gicu]