将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