添加一个唯一的ID字段来识别从VBA导入的不同Excel文件的电子表格
我有两个与标题有关的问题，一个比另一个更重要。 我正在使用下面的代码将一个文件夹中的所有Excel文件导入到我的MS Access数据库：
Option Compare Database Public Function importExcelSheets(Directory As String, TableName As String) As Long On Error Resume Next Dim strDir As String Dim strFile As String Dim strTable As String Dim I As Long I = 0 If Left(Directory, 1) <> "\" Then strDir = Directory & "\" Else strDir = Directory End If strFile = Dir(strDir & "*.XLSX") While strFile <> "" I = I + 1 strFile = strDir & strFile Debug.Print "importing " & strFile DoCmd.TransferSpreadsheet acImport, , TableName, strFile, True, Range:="Sheet1!K:AP" strFile = Dir() Wend importExcelSheets = I End Function 1）我的第一个也是更重要的问题是，我没有办法确定哪个文件是哪个表中的所有从Excel导入，因为这些文件不包含date字段。 我导入的电子表格每天都会生成，所以我想在MS Access表格中创build一个额外的列，其中包含生成date的Excel文件的名称。 要导入的Excel文件将被格式化为“FD Worksheet 01 06 2016”，其名称的date部分与创builddate相关。
有人能告诉我如何去修改我的代码吗？ 理想情况下，我想在date/月/年之间用“/”保存新的date字段，以便格式正确。
2）我的第二个不太重要的问题; 是否有可能只导入特定的领域？ 我上面的代码只能够导入两列之间的字段，而不是特定的。 我只需要列'K'，'N'，'AO'和'AP'（第十一，十四，四十一，四十二列），因为这将大大减lessimport的大小。
解决两个问题的常用工作stream程使用与Excel文件具有相同结构的临时表：
对于每个文件
- 清除临时表
- 将Excel文件导入临时表
- 使用附加查询将所选字段和附加信息（如date或文件名）复制到实际生产表中。
步骤1 + 2的替代方法：链接Excel文件，而不是导入它
（ DoCmd.TransferSpreadsheet acLink ）。
然后追加查询从链接表中select。
无关：
If Left(Directory, 1) <> "\" Then
应该
If Right(Directory, 1) <> "\" Then
您可以使用工作表的Access“附加查询”作为其数据源。 这样，您只能导入所需的列，并且还可以从工作簿文件名中提取date，并将其用于查询参数。
在这个例子中，我只导入一个XLSX文件。 我的访问目标表“FD_Worksheet_master”包含一个名为“file_date”的date/时间字段。 我要导入的Excel数据位于名为“Sheet1”的工作表中。
Dim db As DAO.Database Dim qdf As DAO.QueryDef Dim astrPieces() As String Dim dteFileDate As Date Dim strDir As String Dim strFile As String Dim strInsert As String strDir = "C:\Users\hans\Documents\" strFile = "FD Worksheet 01 06 2016.xlsx" If Not strDir Like "*\" Then strDir = strDir & "\" End If strInsert = "INSERT INTO FD_Worksheet_master (file_date, Annual, Monthly, Hourly)" & vbCrLf & _ "SELECT [which_date] as file_date, xl.Annual, xl.Monthly, xl.Hourly" & vbCrLf & _ "FROM [Excel 12.0 Xml;HDR=YES;IMEX=2;DATABASE=" & strDir & strFile & "].[Sheet1$] AS xl;" Debug.Print strInsert astrPieces = Split(strFile, " ") ' Note: I assumed "01 06 2016" is "mm dd yyyy" format. ' If actually "dd mm yyyy", swap the order of astrPieces(2) and astrPieces(3) dteFileDate = DateSerial(Val(astrPieces(4)), astrPieces(2), astrPieces(3)) Debug.Print dteFileDate Set db = CurrentDb Set qdf = db.CreateQueryDef(vbNullString, strInsert) qdf.Parameters("which_date").Value = dteFileDate qdf.Execute dbFailOnError
您可能需要更改IMEX值; 如果2不起作用，请尝试1。
最后的工作代码如下，使用HansUp的帮助find解决scheme：
Option Compare Database Public Function importExcelSheets1() Dim db As DAO.Database Dim qdf As DAO.QueryDef Dim astrPieces() As String Dim dteFileDate As Date Dim strDir As String Dim strFile As String Dim strInsert As String Dim Directory As String Dim TableName As String Directory = "F:\FD Worksheets\JUN 2016" TableName = "FD_Worksheet_Master" Dim strTable As String Dim I As Long I = 0 If Right(Directory, 1) <> "\" Then strDir = Directory & "\" Else strDir = Directory End If strFile = Dir(strDir & "*.XLSX") While strFile <> "" I = I + 1 Debug.Print "importing " & strFile If Not strDir Like "*\" Then strDir = strDir & "\" End If strInsert = "INSERT INTO FD_Worksheet_master (file_date, Prod, Average_Cost, WSP, RRP)" & vbCrLf & _ "SELECT [which_date] as file_date, xl.Prod, xl.Average_Cost, xl.WSP, xl.RRP" & vbCrLf & _ "FROM [Excel 12.0 Xml;HDR=YES;IMEX=2;DATABASE=" & strDir & strFile & "].[Sheet1$] AS xl;" Debug.Print strInsert astrPieces = Split(Left(strFile, Len(strFile) - 5), " ") dteFileDate = DateSerial(Val(astrPieces(4)), astrPieces(3), astrPieces(2)) Debug.Print dteFileDate Set db = CurrentDb Set qdf = db.CreateQueryDef(vbNullString, strInsert) qdf.Parameters("which_date").Value = dteFileDate qdf.Execute dbFailOnError strFile = Dir() Wend End Function