求助VB编程将Excel2003数据导入Access2003。我半路出家，自学的，上了论坛找，问了度娘，学识在限，结果都不满意，希望得到大夹的解答：


运行结果

看了一下你的文件，问题比较多，重新给你修改了一下，我这里运行没有一点问题。

Private Sub Command2_Click()    ' 选择导入数据的xls文件
  CommonDialog1.Filter = "Excel文件(*.xls)|*.xls"   '筛选Excel文件
  CommonDialog1.ShowOpen
  Str = Me.CommonDialog1.FileName  '导入数据xls文件的位置
  Text1.Text = Str    ' 显示导入数据xls文件的位置
  Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=false;Data Source=" & Text1.Text & ";Extended Properties='Excel 8.0;HDR=Yes'"   'Adodc1打开的是Excel电子表格
     = adCmdTable
    Adodc1.RecordSource = "[Sheet1$]"
    Adodc1.Refresh
      Set DataGrid1.DataSource = Adodc1
      Label1.Caption = "现在：DataGrid1表格显示的是Excel的数据！"     '注意这个标签在导入数据后显示是不一样的。
End Sub

谢版主指教。
现将我编写的完整代码上传，但愿对有同样需求的人有所帮助。
Private Sub Command1_Click()   '导入数据
  CommonDialog1.Filter = "Excel文件(*.xls)|*.xls"   '筛选Excel文件
  CommonDialog1.ShowOpen
'  Str =   '导入数据xls文件的位置
  Text1.Text =   '导入数据xls文件的位置    ' 显示导入数据xls文件的位置
  Adodc2.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=false;Data Source=" & Text1.Text & ";Extended Properties='Excel 8.0;HDR=Yes'"   'Adodc2打开的是Excel电子表格
    = adCmdTable
    Adodc2.RecordSource = "[Sheet1$]"
    Adodc2.Refresh
      Set DataGrid1.DataSource = Adodc2
'      Label1.Caption = "现在：DataGrid1表格显示的是Excel的数据！"     '注意这个标签在导入数据后显示是不一样的。
      
  Dim s As String
   s = App.Path & "\开垦.mdb"
  Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source ='" & s & "';Jet OLEDB:Database Password=chen3523;"   '打开有密码数据库，密码为“chen3523”
    = adCmdTable
    Adodc1.RecordSource = "开垦表"
    Adodc1.Refresh
With DataGrid1
'  .Bookmark = 1
  For i = 1 To .ApproxCount
        Adodc1.Recordset.AddNew
        Adodc1.Recordset("项目名称") = .Columns(0).Text
        Adodc1.Recordset("验收单位") = .Columns(1).Text
        Adodc1.Recordset("验收文号") = .Columns(2).Text
        If .Columns(3).Text <> "" Then Adodc1.Recordset("验收时间") = .Columns(3).Text   '保证Excel表格有空记录时能顺利通过导入
        If .Columns(4).Text <> "" Then Adodc1.Recordset("验收编号") = .Columns(4).Text
        If .Columns(5).Text <> "" Then Adodc1.Recordset("水田面积") = .Columns(5).Text
        If .Columns(6).Text <> "" Then Adodc1.Recordset("水田等级") = .Columns(6).Text
        If .Columns(7).Text <> "" Then Adodc1.Recordset("水浇地面积") = .Columns(7).Text
        If .Columns(8).Text <> "" Then Adodc1.Recordset("水浇地等级") = .Columns(8).Text
        If .Columns(9).Text <> "" Then Adodc1.Recordset("旱地面积") = .Columns(9).Text
        If .Columns(10).Text <> "" Then Adodc1.Recordset("旱地等级") = .Columns(10).Text
        If .Columns(11).Text <> "" Then Adodc1.Recordset("补充耕地图幅号") = .Columns(11).Text
        If .Columns(12).Text <> "" Then Adodc1.Recordset("地类编号") = .Columns(12).Text
        If .Columns(13).Text <> "" Then Adodc1.Recordset("土地现状") = .Columns(13).Text
        If .Columns(14).Text <> "" Then Adodc1.Recordset("完成情况") = .Columns(14).Text
       Adodc1.Recordset.Update
  Next
End With
  MsgBox "本次导入" & DataGrid1.ApproxCount & "条记录，导入结束!"
End Sub

[此贴子已经被作者于2016-9-17 13:02编辑过]

我也下载下来学习学习，谢谢！