添加一個唯一的ID字段來識別從VBA導入的不同Excel文件的電子表格

Question

我有兩個與標題相關的問題，一個比另一個更重要。我使用下面的代碼到一個文件夾中的所有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中接收所有導入的表中，因爲這些文件不包含日期字段。我正在導入的電子表格每天都會生成，因此我想在MS Access表格中創建一個附加列，其中包含生成日期的Excel文件的名稱。要導入的Excel文件將被格式化爲「FD Worksheet 01 06 2016」，其名稱的日期部分與其創建日期相關。

有人能告訴我怎麼去修改我的代碼嗎？理想情況下，我希望在日期/月/年之間用「/」保存新的日期字段，以便格式正確。

2）我的第二個也不太重要的問題;是否有可能只導入特定的字段？我上面的代碼只能導入兩列之間的字段，而不是特定的字段。我只需要列'K'，'N'，'AO'和'AP'（列號11,14,41,42），因爲這將大大減少進口的大小。

Answer 1

最終工作的代碼如下，解決方案是使用HansUp的幫助下找到：

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 

Answer 2

通常的工作流程，同時解決您的問題，使用具有相同的結構Excel文件的臨時表：

對於每個文件

1. 明確的臨時表
2. 導入Excel文件進​​入temp表
3. 使用附加查詢將選定字段以及附加信息（如日期或文件名）複製到實際生產表中。

替代爲步驟1 + 2：鏈路Excel文件，而不是導入它
（DoCmd.TransferSpreadsheet acLink）。

然後追加查詢從鏈接表中選擇。

---

無關：

If Left(Directory, 1) <> "\" Then 

應該

If Right(Directory, 1) <> "\" Then 

Answer 3

您可以使用Access 「追加查詢」 與您的工作表作爲它的數據源。這樣，您只能導入所需的列，並且還可以從工作簿文件名中提取日期並將其用於查詢參數。

在這個例子中，我只導入一個XLSX文件。我的訪問目標表「FD_Worksheet_master」包含一個名爲「file_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。