VB中怎么更新dbf数据库中的数据,可以打开,就是更新不成功
要把vv.xls 中的数据(多条) 更新到TYPE1.dbf数据表中,条件是vv.xls中的"名称"(第一列) "电压伏级"(第二列) "规格"(第三列)分别等于TYPE1.dbf中的model1、model3、model2。把蓝色的代码换成红色的,两种方法都有错误,麻烦各位帮忙看一下,鄙人初来乍到还没有分。
Private Sub Command1_Click()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim xlapp As Excel.Application
Dim xlbook As Excel.Workbook
Dim xlsheet As Excel.Worksheet
On Error GoTo 10
Set xlapp = New Excel.Application
Set xlbook = xlapp.Workbooks.Open("C:\CBGL\vv.xls")
Set xlsheet = xlbook.Worksheets("vv")
If xlsheet.Cells(1, 1) = "名称" And xlsheet.Cells(1, 2) = "ID" And xlsheet.Cells(1, 3) = "规格" And xlsheet.Cells(1, 4) = "单位" _
And xlsheet.Cells(1, 5) = "总量" And xlsheet.Cells(1, 6) = "总价" Then
X = 2
cn.Open "Provider=MSDASQL.1;Driver=Microsoft Visual Foxpro Driver;SourceDB=C:\CBGL \;SourceType=DBF"
rs.Open "select * from TYPE1 ", cn, adOpenKeyset, adLockOptimistic
Do While xlsheet.Cells(X, 1) <> ""
'Sql = "update TYPE1 set m1 ='" & xlsheet.Cells(X, 5) & "',p1='" & xlsheet.Cells(X, 6) & "' where model1 =" & xlsheet.Cells(X, 1) & " and model2 =" & xlsheet.Cells(X, 3) & " and model3 =" & xlsheet.Cells(X, 2) & ""
'rs.Open Sql, cn, 1, 3
' Set rs = cn.Execute(Sql)
rs.Update
If rs.Fields("model1") = Trim(xlsheet.Cells(X, 1)) And rs.Fields("model2") = Trim(xlsheet.Cells(X, 3)) And rs.Fields("model3") = Trim(xlsheet.Cells(X, 2)) Then
rs.Fields("m1") = xlsheet.Cells(X, 5)
rs.Fields("p1") = xlsheet.Cells(X, 6)
End If
X = X + 1
Loop
rs.Close
cn.Close
Else
GoTo 10
End If
xlbook.Close False
xlapp.Quit
Set xlapp = Nothing
MsgBox "数据更新成功!", vbOKOnly + 48, "信息"
'ProgressBar1.Value = 0
Exit Sub
10: MsgBox "更新数据出错,请检查文本!", vbOKOnly + 48, "信息": xlapp.Quit
xlapp.Quit
End Sub