用DAO从EXCEL导入到ACCESS时有导入不完全

Question

Dim j As Long
Dim Db As Database 'open excel file
Dim Rs As RecordsetDim db1 As Database 'open access table
Dim rs1 As RecordsetSet Db = OpenDatabase(e_path, False, False, "Excel 8.0;")
Set Rs = Db.OpenRecordset("t1$")
Rs.MoveLast
j = Rs.RecordCount
Rs.MoveFirstSet db1 = OpenDatabase(a_path & "comet.mdb")
db1.Execute "delete from m1born"
Set rs1 = db1.OpenRecordset("m1born")For i = 1 To j
    rs1.AddNew
        For i1 = 0 To 28
            rs1.Fields(i1) = Rs.Fields(i1)
        Next i1
    rs1.Update
    Rs.MoveNext
Next i
导入时不能完全导入，有部份数据是空的，但大部份都能导入

Answer 1

Dim excel_app As Object 
Dim excel_sheet As Object 
Dim db As Database 
Dim AccessPath As String, AccessTable As String 
Dim sql As String 
Dim frm As New frmMessage 
Dim msg As String 
     
    ADOsdb.BeginTrans 
     
'    With ADOsdb 
'        If .State  <> adStateOpen Then 
'            .CursorLocation = adUseClient 
'            .ConnectionString = gsOdbcName 
'            .Open 
'        End If 
'    End With 
    With dlgCommonDialog 
        .DialogTitle = "打开" 
        .CancelError = False 
        'ToDo:   设置   common   dialog   控件的标志和属性 
        .Filter = "Excel文件   (*.xls) ¦*.xls" 
        .ShowOpen 
        If Len(.FileName) = 0 Then 
                Exit Sub 
        End If 
        sfile = .FileName 
    End With 
  
   
  AccessPath = lcspath & "\db.mdb"                                 '数据库路径 
  excelpath = sfile                                                  '电子表格路经 
  AccessTable = "db"                                                 '数据库内表格 
   
  msg = Trim(InputBox("请输入表名，如sheet1或sheet2：", "工作表", "sheet1")) 
'  msg = Str(msg) 
  sheet = msg                                            '电子表格内工作表 
  Set db = OpenDatabase(excelpath, True, False, "Excel 8.0") '打开电子表格文件 
  sql = ("Select * into [;database=" & AccessPath & "]." & AccessTable & " FROM [" & sheet & "$]") 
'  sql = ("Select * into [;database=" & AccessPath & "]." & AccessTable & " FROM [" & sheet & "]") 
     
  If sheet = "" Then 
      MsgBox "您选择的EXCEL表不存在，请重新导入！", vbInformation, "抱歉！" 
      Exit Sub 
  End If 
   
  If deltable = 1 Then 
    With ADOsdb 
        .Execute "drop table db", , adCmdText 
    End With 
  End If 
   
  ADOsdb.CommitTrans   db.Execute (sql)                                         '将电子表格导入数据库 
                 
                 
  ShowMessage "正在导入EXCEL表，请您稍等..." 
  Timer1.Enabled = True 
   

Answer 2

数据不能完全导入是因为Excel表中的列的格式与数据表的列的格式不同造成的，修改一下Excel表列的格式使其与数据库的一样，在试试，另外，trim(Rs.Fields(i1))改一下。

Answer 3

TEST过,不行..真是烦啊!~..烦几天了!

Answer 4

有可能是EXCEL某一列中文、数字混合导致的。楼主可以先读一下数据看看是不是无法读取。
若是这个问题在所有数据前加'，转成文本就行了