Appending Multiple File to Multiple Tables (1 Viewer)

Private Sub Command24_Click()

'Error handling
    On Error GoTo Error_Handler

Dim dbs         As DAO.Database
Dim tbl         As DAO.TableDef
Dim iResponse   As Integer

Set dbs = CurrentDb

'Confirm that the user wants to complete this append
    iResponse = MsgBox("This action will APPEND the monthly detail, " & vbNewLine & _
                    "Do you want to continue? ", vbQuestion + vbYesNo, "Warning")
                    
If iResponse = vbYes Then

'Turn off warnings
    DoCmd.SetWarnings False
    Application.Echo False
    
'Check if any tables that need to be updated are open
    For Each tbl In CurrentDb.TableDefs
        DoCmd.Close acTable, tbl.Name, acSaveYes
    Next
    
    
'Delete all records in the HEAD COUNT and TEMP HEAD COUNT Tables
    dbs.Execute "qryHEAD_COUNT_DELETE"
    dbs.Execute "qryTEMP_HEAD_COUNT_DELETE"
    
      
'Import all the files within the "MONTHLY APPEND FILES" folder
'Import the LEDGER DETAIL table
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "TBL_LEDGER_DETAIL", _
        "Y:\Budget process information\MS ACCESS\MONTHLY APPEND FILES\MONTHLY APPEND FILES\1. LEDGER_DETAIL.xlsx", True

'Import the FLBGA table
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "TBL_FLBGA", _
        "Y:\Budget process information\MS ACCESS\MONTHLY APPEND FILES\MONTHLY APPEND FILES\2. FLBGA_DETAIL.xlsx", True

'Import the HEAD COUNT table
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "TBL_HEAD_COUNT", _
        "Y:\Budget process information\MS ACCESS\MONTHLY APPEND FILES\MONTHLY APPEND FILES\3. HEAD_DETAIL.xlsx", True

'Import the TEMP HEAD COUNT table
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "TBL_TEMP_HEAD_COUNT", _
        "Y:\Budget process information\MS ACCESS\MONTHLY APPEND FILES\MONTHLY APPEND FILES\4. TEMP_HEAD_DETAIL.xlsx", True
        
'Import the MUSEUM table
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "TBL_MUSEUM", _
        "Y:\Budget process information\MS ACCESS\MONTHLY APPEND FILES\MONTHLY APPEND FILES\5. MUSGA_DETAIL.xlsx", True
    
'Import the JPIIA table
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "TBL_JPIIA", _
        "Y:\Budget process information\MS ACCESS\MONTHLY APPEND FILES\MONTHLY APPEND FILES\6. JPIIA_DETAIL.xlsx", True

        
'Delete Import Error tables
    Do Until IsNull(DLookup("Name", "Msysobjects", "Name like '*ImportErrors*'"))
        DoCmd.DeleteObject acTable, DLookup("Name", "Msysobjects", "Name like '*ImportErrors*'")
    Loop


'Turn on warnings
    DoCmd.SetWarnings True
    Application.Echo True
    
'Confirmation
        MsgBox "Success!  That's some good work, " & vbNewLine _
                & "Your data was successfully appended ", vbInformation, "GREAT JOB"
Else
        MsgBox "D'OH!      ", vbInformation, "CHECK YA LATER!"
End If
Exit Sub
        

Error_Handler_Exit:
    Exit Sub

Error_Handler:
    Select Case Err.NUMBER
        Case 94
            Err.Clear
            Resume Error_Handler_Exit
        Case Else
            MsgBox "Error No. " & Err.NUMBER & vbCrLf & "Description: " & Err.DESCRIPTION, vbExclamation, "Database Error"
            Err.Clear
            Resume Error_Handler_Exit
    End Select
    
End Sub

sTableArray = Array(TBL_LEDGER_DETAIL, TBL_FLBGA, TBL_HEAD_COUNT, TBL_TEMP_HEAD_COUNT,TBL_MUSEUM,TBL_JPIIA)

sFileArray = Array(1. LEDGER_DETAIL.xlsx, 2. FLBGA_DETAIL.xlsx, 3. HEAD_DETAIL.xlsx, 4. TEMP_HEAD_DETAIL.xlsx,5. MUSGA_DETAIL.xlsx,6. JPIIA_DETAIL.xlsx)

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, sTableArray, _
        "Y:\Budget process information\MS ACCESS\MONTHLY APPEND FILES\MONTHLY APPEND FILES\sFileArray, True

Private Sub Command24_Click()

'Error handling
    On Error GoTo Error_Handler

    Dim dbs         As DAO.Database
    Dim tbl         As DAO.TableDef
    Dim iResponse   As Integer
    Dim sTable(5)   As String
    Dim sFile(5)    As String
    Dim sFilePath   As String
    Dim i           As Integer
    Dim j           As Integer
    
    
'Confirm that the user wants to complete this append
    iResponse = MsgBox("This action will APPEND the monthly detail tables, " & vbNewLine & _
                    "Do you want to continue? ", vbQuestion + vbYesNo, "Warning")
                    
If iResponse = vbYes Then

'Turn off warnings
    DoCmd.SetWarnings False
    Application.Echo False
    
'Set dbs and file path of folder
    Set dbs = CurrentDb
    sFilePath = "Y:\Budget process information\MS ACCESS\MONTHLY APPEND FILES\MONTHLY APPEND FILES\"
  
'If tables are open, close
    For Each tbl In CurrentDb.TableDefs
        DoCmd.Close acTable, tbl.Name, acSaveYes
    Next
  
'Delete all records in the HEAD COUNT and TEMP HEAD COUNT Tables
    dbs.Execute "qryHEAD_COUNT_DELETE"
    dbs.Execute "qryTEMP_HEAD_COUNT_DELETE"

'Array's
    sTable(0) = "TBL_LEDGER_DETAIL"
    sTable(1) = "TBL_FLBGA"
    sTable(2) = "TBL_HEAD_COUNT"
    sTable(3) = "TBL_TEMP_HEAD_COUNT"
    sTable(4) = "TBL_MUSEUM"
    sTable(5) = "TBL_JPIIA"

    sFile(0) = "1. LEDGER_DETAIL.xlsx"
    sFile(1) = "2. FLBGA_DETAIL.xlsx"
    sFile(2) = "3. HEAD_DETAIL.xlsx"
    sFile(3) = "4. TEMP_HEAD_DETAIL.xlsx"
    sFile(4) = "5. MUSGA_DETAIL.xlsx"
    sFile(5) = "6. JPIIA_DETAIL.xlsx"
    
    
'Loop through table and appends
    For i = LBound(sTable) To UBound(sTable)
        DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, sTable(i), _
            sFilePath & sFile(i), True
                Debug.Print sTable(i)
                Debug.Print sFilePath & sFile(i)
    Next i
    
'Delete Import Error tables
    Do Until IsNull(DLookup("Name", "Msysobjects", "Name like '*ImportErrors*'"))
        DoCmd.DeleteObject acTable, DLookup("Name", "Msysobjects", "Name like '*ImportErrors*'")
    Loop

'Turn on warnings
    DoCmd.SetWarnings True
    Application.Echo True


'Confirmation
     MsgBox "Success!  That's some good work, " & vbNewLine _
                & "Your data was successfully appended ", vbInformation, "GREAT JOB"
Else
        MsgBox "D'OH!      ", vbInformation, "CHECK YA LATER!"
End If
Exit Sub



Error_Handler_Exit:
    Exit Sub

Error_Handler:
    Select Case Err.NUMBER
        Case 94
            Err.Clear
            Resume Error_Handler_Exit
        Case Else
            MsgBox "Error No. " & Err.NUMBER & vbCrLf & "Description: " & Err.DESCRIPTION, vbExclamation, "Database Error"
            Err.Clear
            Resume Error_Handler_Exit
    End Select
    
End Sub