如何将excel数据导入access?

SRONE

请问各位大侠，能否用程序把excel数据导入access的表单中，但是EXCEL表格中的表头不需要导入ACCESS中，以后只要把EXCEL表格中新增加的数据追加到原ACCESS的相应表单中即可，同时能自动删除EXCEL表格中的数据。

SRONE

请高手多指点指点

SRONE

以下的程序，请各位大师帮我指点一下


Private Sub cmd导入_Click()

On Error Resume Next
    Dim exapp As New Excel.Application
    Dim exBook As Excel.Workbook
    Dim exSheet As Excel.Worksheet
    Dim i As Integer
    Dim strName As String
    Set exBook = exapp.Workbooks.Open(CurrentProject.Path & "\扣罚款单工作薄.xls")
    For i = 2 To exBook.Sheets.Count
        DoCmd.TransferSpreadsheet acImport, , "KFKtable", CurrentProject.Path & _
            "\扣罚款单工作薄.xls", True, exBook.Worksheets(i).name & "!"
    Next
    exBook.Close
    Set exBook = Nothing
    exapp.Quit

End Sub

wuheng

自己动手SOU一下,好象有蛮多例子的,

narcissus82

我刚好有个例子，你可以自己研究下！

Public Function OpenEXCEL_SaveSheetTo_Access() As Boolean

   Dim obj_newExcelApp  As New Excel.Application
   Dim obj_newExcelBook As New Excel.Workbook
   Dim obj_newWorkSheet As New Excel.Worksheet
   Dim str_aryReadData(17) As String
   Dim iii As Long, jjj As Long, kkk As Long
   Dim obj_DataBase As DAO.Database
   Dim obj_DataRecordGo As DAO.Recordset
   obj_newExcelApp.Workbooks.Open "D:\保单续缴表_sz.xls"
   Set obj_newExcelBook = obj_newExcelApp.Workbooks(1)
   Set obj_newWorkSheet = obj_newExcelBook.Sheets(1)
   
   kkk = obj_newWorkSheet.Rows.count
   jjj = 1
   Set obj_DataBase = CurrentDb()
   Do While jjj < kkk
      jjj = jjj + 1
      For iii = 0 To 17
          str_aryReadData(iii) = Space(0)
      Next iii
      str_aryReadData(1) = Trim(obj_newWorkSheet.Cells(jjj, 1))
      str_aryReadData(2) = Trim(obj_newWorkSheet.Cells(jjj, 2))
      str_aryReadData(3) = Trim(obj_newWorkSheet.Cells(jjj, 3))
      str_aryReadData(4) = Trim(obj_newWorkSheet.Cells(jjj, 4))
      str_aryReadData(5) = Trim(obj_newWorkSheet.Cells(jjj, 5))
      str_aryReadData(6) = Trim(obj_newWorkSheet.Cells(jjj, 6))
      str_aryReadData(7) = Trim(obj_newWorkSheet.Cells(jjj, 7))
      str_aryReadData(8) = Trim(obj_newWorkSheet.Cells(jjj, 8))
      str_aryReadData(9) = Trim(obj_newWorkSheet.Cells(jjj, 9))
      str_aryReadData(10) = Trim(obj_newWorkSheet.Cells(jjj, 10))
      str_aryReadData(11) = Trim(obj_newWorkSheet.Cells(jjj, 11))
      str_aryReadData(12) = Trim(obj_newWorkSheet.Cells(jjj, 12))
      str_aryReadData(13) = Trim(obj_newWorkSheet.Cells(jjj, 13))
      str_aryReadData(14) = Trim(obj_newWorkSheet.Cells(jjj, 14))
      str_aryReadData(15) = Trim(obj_newWorkSheet.Cells(jjj, 15))
      str_aryReadData(16) = Trim(obj_newWorkSheet.Cells(jjj, 16))
      str_aryReadData(17) = Trim(obj_newWorkSheet.Cells(jjj, 17))
      
      If (Trim(str_aryReadData(1)) = Space(0)) And (Trim(str_aryReadData(2)) = Space(0)) And _
         (Trim(str_aryReadData(3)) = Space(0)) And (Trim(str_aryReadData(4)) = Space(0)) And _
         (Trim(str_aryReadData(5)) = Space(0)) Then
         Exit Do
      End If
      Set obj_DataRecordGo = obj_DataBase.OpenRecordset("保单续缴表_sz", dbOpenDynaset)
         obj_DataRecordGo.AddNew
         obj_DataRecordGo![渠道] = str_aryReadData(1)
         obj_DataRecordGo![生效日] = str_aryReadData(2)
         obj_DataRecordGo![电销员] = str_aryReadData(3)
         obj_DataRecordGo![保单号码] = str_aryReadData(4)
         obj_DataRecordGo![投保人] = str_aryReadData(5)
         obj_DataRecordGo![被保人] = str_aryReadData(6)
         obj_DataRecordGo![险种] = str_aryReadData(7)
         obj_DataRecordGo![缴费年限] = str_aryReadData(8)
         obj_DataRecordGo![缴费方式] = str_aryReadData(9)
         obj_DataRecordGo![每期保费] = str_aryReadData(10)
         obj_DataRecordGo![已缴次数] = str_aryReadData(11)
         obj_DataRecordGo![已缴保费] = str_aryReadData(12)
         obj_DataRecordGo![最近缴费日期] = str_aryReadData(13)
         obj_DataRecordGo![应缴未缴次数] = str_aryReadData(14)
         obj_DataRecordGo![应缴未缴保费] = str_aryReadData(15)
         obj_DataRecordGo![保单状态] = str_aryReadData(16)
         'obj_DataRecordGo![失效日期] = str_aryReadData(17)
         obj_DataRecordGo.Update
   Loop
   obj_DataBase.close
   obj_newExcelBook.close
   obj_newExcelApp.Workbooks.close
   MsgBox "资料处理完成", vbOKOnly + vbInformation, "Message Dialog"
End Function

SRONE

谢谢指点，能否将的实例传给我借鉴一下吗？我的邮箱为：shu2008jy@126.com