将两百多张EXCEL表数据导入到ACCESS中有什么快捷省时方式吗？

Excel导入Access后建立查询窗

我提供一段代码让你参考 On Error GoTo Err_ If IsNull(Me。txtPath) = True Or Me。txtPath = "" Then MsgBox "请选择要导入的文件！", vbExclamation Exit Sub End If Dim adoConnection1 As New ADODB。 Connection Dim adoRecordset1 As New ADODB。Recordset adoConnection1。Open "Data Provider=MSDASQL。1;driver=Microsoft Excel Driver (*...全部

  我提供一段代码让你参考 On Error GoTo Err_ If IsNull(Me。txtPath) = True Or Me。txtPath = "" Then MsgBox "请选择要导入的文件！", vbExclamation Exit Sub End If Dim adoConnection1 As New ADODB。
  Connection Dim adoRecordset1 As New ADODB。Recordset adoConnection1。Open "Data Provider=MSDASQL。1;driver=Microsoft Excel Driver (*。
  xls);DBQ=" & txtPath adoRecordset1。Open "select * from [sheet1$]", adoConnection1, adOpenKeyset, adLockOptimistic Dim I As Integer For I = 1 To adoRecordset1。
  RecordCount - 1 '判断费用是否正确 If IsNumeric( em(4)。Value) = False Then MsgBox "要导入的费用数据不正确，请更正后再导入！！", vbExclamation Exit Sub End If '判断科目是否在系统中存在 Dim cn1 As Object, rs1 As Object, sql1 As String Set cn1 = Application。
  CurrentProject。Connection Set rs1 = CreateObject(" cordset") sql1 = "select * from [tblDimCostAccount] where [CostAccountAlternateKey] =" & em(0)。
  Value rs1。Open sql1, cn1, 1, 1 If rs1。EOF Then MsgBox "要导入的科目系统中不存在，请更正后再导入！", vbExclamation Exit Sub End If rs1。
  Close cn1。Close '判断机台是否在系统中存在 Dim cn2 As Object, rs2 As Object, sql2 As String Set cn2 = Application。
  CurrentProject。Connection Set rs2 = CreateObject(" cordset") sql2 = "select * from [tblBaseData] where [Sort] ='" & "WorkCenterKey" & "'And [Value]='" & em(3)。
  Value & "'" rs2。Open sql2, cn2, 1, 1 If rs2。EOF Then MsgBox "要导入的机台系统中不存在，请更正后再导入！", vbExclamation Exit Sub End If rs2。
  Close cn2。Close adoRecordset1。MoveNext Next I adoRecordset1。Cancel adoConnection1。Cancel Dim adoConnection As New ADODB。
  Connection Dim adoRecordset As New ADODB。Recordset adoConnection。Open "Data Provider=MSDASQL。1;driver=Microsoft Excel Driver (*。
  xls);DBQ=" & txtPath adoRecordset。Open "select * from [sheet1$]", adoConnection, adOpenKeyset, adLockOptimistic Dim a As Integer Dim cn As Object, rs As Object, sql As String Set cn = Application。
  CurrentProject。Connection Set rs = CreateObject(" cordset") sql = "select * from [tblFactWorkCenterKey]" rs。
  Open sql, cn, 3, 3 If IsNull(DLookup("[ID]", "tblFactWorkCenterKey", "[CanlendarYear] ='" & Me。
  txtyear & "' And [CanlendarMonth]=" & Me。txtmonth & "")) = False Then If MsgBox(Me。txtyear & "年" & Me。
  txtmonth & "月的数据已经导入，是否要替换？", vbYesNo + vbQuestion) = vbYes Then DoCmd。SetWarnings 0 DoCmd。
  RunSQL "DELETE * FROM tblFactWorkCenterKey WHERE (((tblFactWorkCenterKey。CanlendarYear)=[Forms]![pfrmImportFactWorkCenterKey]![txtYear]) AND ((tblFactWorkCenterKey。
  CanlendarMonth)=[Forms]![pfrmImportFactWorkCenterKey]![txtMonth]));" DoCmd。SetWarnings -1 For a = 1 To adoRecordset。
  RecordCount - 1 rs。AddNew rs("CanlendarYear") = Me。txtyear rs("CanlendarMonth") = Me。
  txtmonth rs("CostAccountAlternateKey") = em(0)。Value rs("WorkCenterKey") = em(3)。
  Value rs("TotalCost") = em(4)。Value rs。Update adoRecordset。
  MoveNext Next a rs。Close cn。Close Forms![frmFactWorkCenterKey]![Child4]。
  Requery adoRecordset。Cancel adoConnection。Cancel MsgBox "数据导入成功！", vbInformation Else Exit Sub End If Else For a = 1 To adoRecordset。
  RecordCount - 1 rs。AddNew rs("CanlendarYear") = Me。txtyear rs("CanlendarMonth") = Me。
  txtmonth rs("CostAccountAlternateKey") = em(0)。Value rs("WorkCenterKey") = em(3)。
  Value rs("TotalCost") = em(4)。Value rs。Update adoRecordset。MoveNext Next a rs。
  Close cn。Close Forms![frmFactWorkCenterKey]![Child4]。Requery adoRecordset。Cancel adoConnection。
  Cancel MsgBox "数据导入成功！", vbInformation End If Exit_: Exit Sub Err_: If Err。Number = -2147467259 Then MsgBox "要导入的费用数据不正确，请更正后再导入！", vbExclamation Else MsgBox Err。
  Description End If Resume Exit_ 。收起