將Excel數據導入Access

Question

我必須將Excel工作表中的數據導入Access數據庫。 Excel工作表和Access數據庫的數據結構非常不同，因此需要進行大量重新格式化/重組。所以我喜歡用VBA導入數據。我知道我可以從VBA打開Excel實例中的表格，然後讀取，轉換並將其保存在表格中。這是做到這一點的最佳方式，還是有辦法以某種方式將整個工作表加載到Access/VBA中，並在未打開Excel實例的情況下導航數據。謝謝。

馬塞爾

Answer 1

你爲什麼不導入Excel數據到臨時表（即Excel電子表格相匹配），然後跨到正確的Access表複製。

如果它是1-1記錄副本（但有重命名/轉換），你可以使用查詢來完成。否則，您可以遍歷VBA中的入口Excel表格。

Answer 2

這是將記錄插入現有數據庫的最新工作示例，這些字段都是從作爲輸入表單設計的工作表中拉出來的。

Option Explicit 

Private Sub insert_motor_to_DB() 
'This sub will insert the motor data into the database as a new record 

Dim msrSheet As Worksheet 

Dim mtrSizeLoc As Range 
Dim dateLoc As Range 
Dim mtrSNLoc As Range 
Dim mtrTechLoc As Range 
Dim regLoc As Range 
Dim custLoc As Range 
Dim rigLoc As Range 
Dim jobLoc As Range 
Dim rotorSNLoc As Range 
Dim rotorSizeLoc As Range 
Dim rotorNULoc As Range 
Dim rotorMeasLoc As Range 
Dim rotorCoCLoc As Range 
Dim statorSNLoc As Range 
Dim statorSizeLoc As Range 
Dim statorNULoc As Range 
Dim statorMeasLoc As Range 
Dim elastomerMFGLoc As Range 
Dim BHAoFLoc As Range 
Dim bendAngleLoc As Range 
Dim protractorLoc As Range 
Dim statorConfigLoc As Range 
Dim topConLoc As Range 
Dim topWBLoc As Range 
Dim SoSLoc As Range 
Dim stabSizeLoc As Range 
Dim BAtypeLoc As Range 
Dim botConLoc As Range 
Dim fitLoc As Range 
Dim comments As String 
Dim regSTR As String 
Dim custSTR As String 
Dim rigSTR As String 
Dim jobSTR As String 
Dim stabSizeSTR As String 
Dim rotorMeasSTR As String 

Dim conn2 As Object ' connection 
Dim rs As Object 'record set 
Dim strConnection As String 
Dim insertSQL As String 

'Set up the range locations for validation 
Set msrSheet = ThisWorkbook.Worksheets("Generate MSR") 

Set mtrSizeLoc = msrSheet.Range("O5") 
Set dateLoc = msrSheet.Range("O7") 
Set mtrSNLoc = msrSheet.Range("O6") 
Set mtrTechLoc = msrSheet.Range("O8") 
Set regLoc = msrSheet.Range("O9") 
Set custLoc = msrSheet.Range("O10") 
Set rigLoc = msrSheet.Range("O11") 
Set jobLoc = msrSheet.Range("O12") 
Set rotorSNLoc = msrSheet.Range("O13") 
Set rotorSizeLoc = msrSheet.Range("Q14") 
Set rotorNULoc = msrSheet.Range("O14") 
Set rotorMeasLoc = msrSheet.Range("O15") 
Set rotorCoCLoc = msrSheet.Range("O16") 
Set statorSNLoc = msrSheet.Range("O18") 
Set statorSizeLoc = msrSheet.Range("Q19") 
Set statorNULoc = msrSheet.Range("O19") 
Set statorMeasLoc = msrSheet.Range("O20") 
Set elastomerMFGLoc = msrSheet.Range("O21") 
Set BHAoFLoc = msrSheet.Range("O23") 
Set bendAngleLoc = msrSheet.Range("O24") 
Set protractorLoc = msrSheet.Range("O25") 
Set statorConfigLoc = msrSheet.Range("O28") 
Set topConLoc = msrSheet.Range("O29") 
Set topWBLoc = msrSheet.Range("O30") 
Set SoSLoc = msrSheet.Range("O33") 
Set stabSizeLoc = msrSheet.Range("O34") 
Set BAtypeLoc = msrSheet.Range("O35") 
Set botConLoc = msrSheet.Range("O36") 
Set fitLoc = msrSheet.Range("J18") 


'get comments 
comments = msrSheet.OLEObjects("TextBox1").Object.Text 


'Check for allowable zeroes = unfilled fields 
If regLoc.value = 0 Then 
    regSTR = "Not Assigned" 
Else ' Do nothing at this time 
    regSTR = regLoc.value 
End If 

If custLoc.value = 0 Then 
    custSTR = "Not Assigned" 
Else ' Do nothing at this time 
    custSTR = custLoc.value 
End If 

If rigLoc.value = 0 Then 
    rigSTR = "Not Assigned" 
Else ' Do nothing at this time 
    rigSTR = rigLoc.value 
End If 

If jobLoc.value = 0 Then 
    jobSTR = "Not Assigned" 
Else ' Do nothing at this time 
    jobSTR = jobLoc.value 
End If 


If stabSizeLoc.value = 0 Then 
    stabSizeSTR = "No Stab" 
Else ' Do nothing at this time 
    stabSizeSTR = stabSizeLoc.value 
End If 

'set up db connection 
Set conn2 = CreateObject("ADODB.Connection") 
'provide the path 
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _ 
    "Data Source=C:\Users\Documents\xxMotorShopProject\DB_testingMTRS.accdb" 

'open the DB 
On Error GoTo ErrHandler2: 
conn2.Open strConnection 

'Perform the insert 

insertSQL = "INSERT INTO tbl_mtrTEST ([mtrSize], [mtrSN], [buildDate], [mtrTech],[region],[customer],[rig],[jobNum], " & _ 
      "[rotorSN],[rotorSize],[rotorNU], [rotorMeas], [rotorCoC], [statorSN], [statorSize], [statorNU], [statorMeas]," & _ 
      "[elastMFG], [AoF], [bendAngle], [protractorAngle], [statorConfig], [topCon], [topWB], [SoS]," & _ 
      "[stabSize], [BAtype], [botCon], [fit], [comments], [teardownYN]) " & _ 
     " VALUES (""" & mtrSizeLoc.value & """, """ & mtrSNLoc.value & """, """ & dateLoc.value & """, """ & mtrTechLoc.value & """," & _ 
     " """ & regSTR & """, """ & custSTR & """, """ & rigSTR & """, """ & jobSTR & """," & _ 
     " """ & rotorSNLoc.value & """, """ & rotorSizeLoc.value & """, """ & rotorNULoc.value & """, """ & Format(rotorMeasLoc.value, "0.000") & """," & _ 
     " """ & rotorCoCLoc.value & """, """ & statorSNLoc.value & """, """ & statorSizeLoc.value & """, """ & statorNULoc.value & """," & _ 
     " """ & Format(statorMeasLoc.value, "0.000") & """, """ & elastomerMFGLoc.value & """, """ & BHAoFLoc.value & """, """ & Format(bendAngleLoc.value, "0.00") & """," & _ 
     " """ & Format(protractorLoc.value, "0.00") & """, """ & statorConfigLoc.value & """, """ & topConLoc.value & """, """ & topWBLoc.value & """," & _ 
     " """ & SoSLoc.value & """, """ & stabSizeSTR & """, """ & BAtypeLoc.value & """, """ & botConLoc.value & """, """ & fitLoc & """ ," & _ 
     " """ & comments & """,""" & "No Teardown""" & "); " 

On Error GoTo ErrHandler3: 
conn2.Execute insertSQL 


Application.Run "clear_MSR.clear_MSR" 

JumpOut2: 
JumpOut3: 
conn2.Close 
Set conn2 = Nothing 

Exit Sub 

ErrHandler2: 
MsgBox "The database file can not be accessed. Please report this behavior.", , "Database Connection Error" 
Application.Run ("ERR_DB_Open.emailERR_openDB") 
Resume JumpOut2: 

ErrHandler3: 
MsgBox "The database write failed. Please report this behavior.", , "Database Write Error" 
Application.Run ("ERR_DB_Write.emailERR_writeDB") 
Resume JumpOut3: 

End Sub 

錯誤處理模塊是來自Outlook的電子郵件。那是另一個話題。清除表格的模塊只是清除位置。

如果你打算寫入VBA插入記錄到Access中，也許這會幫助你。

順便說調用從工作簿中的其他地方的代碼私有模塊，你必須這樣做：

Application.Run "modulename.methodname", argument1, argument2 'if there are any arguments 

它不是一個很長的過程，設置您的字段名稱和您的工作地點建立查詢佔用的空間/時間最多。

插入將添加記錄並自動爲該行分配一個新的ID。

乾杯 - WWC