Question

首先，这是来自各种来源的代码汇编，尽管我想赞美，但我找不到发起人。道歉。

困境，我有5个电子表格，所有不同的名称，每个电子表格上有一个与文件名称相同的选项卡，在Access中有相应的表名相同（保持简单。）在代码中在下面，它将第一个工作表选项卡数据导入到Access中的相应表中，并提示我输入完成后的消息框。但是，没有其他表被导入，这是有道理的。我错过了一个组件来调用每个文件而不是一个工作表。仅供参考，我无法将这些文件合并到一个工作表中，因为有些工作表有大量数据。它们都是.xlsb文件。我错过了一步吗？

Function Fnc_ImportData()

Dim strPathFile As String, strFile As String, strPath As String
Dim blnHasFieldNames As Boolean
Dim intWorksheets As Integer

 ' delete the current data in all 5 tables in Access
 DoCmd.OpenQuery "qry_F2F_Alloc_tblDataDelete"
 DoCmd.OpenQuery "qry_GDM_USD_tblDataDelete
 DoCmd.OpenQuery "qry_GDM_USD_BDGT_tblDataDelete
 DoCmd.OpenQuery "qry_IntraHR_Data_tblDataDelete
 DoCmd.OpenQuery "qry_IT_ProjectCosts_tblDataDelete


 ' Replace (1 to #) with the number of worksheets to be imported
 ' from each EXCEL file
 Dim strWorksheets(1 To 5) As String

 ' Replace (1 to #) with the number of worksheets to be imported
 ' from each EXCEL file (this code assumes that each worksheet
 ' with the same name is being imported into a separate table
 ' for that specific worksheet name)
 Dim strTables(1 To 5) As String

 ' Replace generic worksheet names with the real worksheet names;
 ' add / delete code lines so that there is one code line for
 ' each worksheet that is to be imported from each workbook file
 ' strWorksheets(1) = "GenericWorksheetName1"
 strWorksheets(1) = "tbl_F2F_Alloc"
 strWorksheets(2) = "tbl_GDM_USD"
 strWorksheets(3) = "tbl_GDM_USD_BDGT"
 strWorksheets(4) = "tbl_IT_ProjectCosts"
 strWorksheets(5) = "tbl_IntraHR_Data"


 ' Replace generic table names with the real table names
 ' strTables(1) = "GenericTableName1"
 strTables(1) = "tbl_F2F_Alloc"
 strTables(2) = "tbl_GDM_USD"
 strTables(3) = "tbl_GDM_USD_BDGT"
 strTables(4) = "tbl_IT_ProjectCosts"
 strTables(5) = "tbl_IntraHR_Data"

 ' Change this next line to True if the first row in EXCEL worksheet
 ' has field names
 blnHasFieldNames = True

 ' Replace C:\Documents\ with the real path to the folder that
 ' contains the EXCEL files
 strPath = "\\admpls173m\findata\Functions_Finance\HR Monthly       PnL\2-Database\Files\TEST MAIN FILES\"

 ' Replace # with the number of worksheets to be imported
 ' from each EXCEL file
 ' For intWorksheets = 1 To #
 For intWorksheets = 1 To 5
       strFile = Dir(strPath & "*.xlsb")
       Do While Len(strFile) > 0
             strPathFile = strPath & strFile
             DoCmd.TransferSpreadsheet acImport, _
                   acSpreadsheetTypeExcel12, strTables(intWorksheets), _
                   strPathFile, blnHasFieldNames, _
                   strWorksheets(intWorksheets) & "$"
             strFile = Dir()
       Loop
 Next intWorksheets

 DoCmd.SetWarnings True
 'Message box telling you the data has been imported into the Tbl_Summary
 MsgBox "Access Has Finished Importing the Files." & Chr(13) & "Data Is Ready To Be Reviewed.", vbInformation
 Exit_File1_Click:
     Exit Function
 Err_File1_Click:
     MsgBox Err.Description
     Resume Exit_File1_Click

 End Function

将单独的Excel 2016工作表导入单独的Access 2016表

0 个答案: