旧事重提（将excel数据一条条导入Access中）！输球，程序又出错,郁闷！！！问题出在excel sheet1的串号一列本来有数据却出现没有数据的提
Dim adoConnection As New ADODB.Connection
Dim cn As New ADODB.Connection
Dim adoRecordset As New ADODB.Recordset
Dim rs As New ADODB.Recordset
Dim S1, s, fpath, sql, s2 As String
Dim n, i As Integer
n = 0
On Error GoTo err1
fpath = File1.Path & "\" & File1.FileName
If adoConnection.State = adStateClosed Then
adoConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=" & fpath & ";Extended Properties='Excel 8.0;HDR=Yes'"
End If
adoRecordset.Open "select * from [sheet1$]", adoConnection, adOpenKeyset, adLockOptimistic
For i = 0 To adoRecordset.Fields.Count - 1
Debug.Print adoRecordset.Fields(i).Name
Next
If cn.State = adStateClosed Then
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=d:\库存管理系统\sdch.mdb;Persist Security Info=False"
End If
If Not (adoRecordset.BOF And adoRecordset.EOF) Then
Pr1.Max = adoRecordset.RecordCount
MsgBox "记录的总数为：" & adoRecordset.RecordCount, vbOKOnly + vbInformation, "提示！"
If Text1 <> "" Then
i = Text1 - 2
adoRecordset.Move i
End If
Pr1.Value = 0
End If
Do Until adoRecordset.EOF
If Len((adoRecordset.Fields(2))) < 15 Then MsgBox "串号长度不足十五位！"
s = Mid$(Trim$(adoRecordset.Fields(2)), 1, 15)
sql = "insert into 串号(地区,型号,串号,代理商,盘点人) values('" & adoRecordset.Fields(0) & "','" & adoRecordset.Fields(1) & "','" & s & "','" & adoRecordset.Fields(3) & "','" & adoRecordset.Fields(4) & "' )"
Debug.Print sql
S1 = "select * from 串号 where 串号='" & s & "'"
Set rs = cn.Execute(S1)
If Not rs.EOF Then
s2 = s2 & " " & s
S1 = "insert into 失败串号(串号) values('" & s & "')"
cn.Execute S1, adCmdText
Else
n = n + 1
cn.Execute sql, adCmdText
Debug.Print sql
End If
adoRecordset.MoveNext
Pr1.Value = Pr1.Value + 1
Loop
MsgBox "导入成功！ " & n & "条:未成功的串号为：" & vbCrLf & s2 & "!", vbInformation + vbOKCancel, "提示！"
Exit Sub
err1:
MsgBox " 原因：" & Err.Description & vbCrLf & "出错位置:第" & adoRecordset.AbsolutePosition & " 条出错！" & vbCrLf, vbInformation, "错误信息！"
问题点数：0、回复次数：0Top
