vb 更新时,提示更新成功,但实际数据没有变化,请高手看一下代码那里错了
Sub simplesave()Dim myBar As CommandBar
Dim NewItem
For Each myBar In CommandBars
If myBar.Name = "生产系统" Then
("生产系统").Delete
End If
Next
(Name:="生产系统").Visible = True
With CommandBars("生产系统")
.Position = msoBarTop
End With
Set NewItem2 = CommandBars("生产系统").Controls.Add(Type:=msoControlButton)
With NewItem2
.BeginGroup = True
.Caption = "德恩成品定额"
.OnAction = "decpde"
.Style = msoButtonCaption
End With
End Sub
Sub decpde()
Dim ConnDB As ADODB.Connection
Set ConnDB = New ADODB.Connection
Dim ConnStr As String
Dim DBRst As ADODB.Recordset
Set DBRst = New ADODB.Recordset
Dim SQLRst As String
Dim rng As Range, str$
Dim OraOpen As Boolean
Dim cmd As
Dim Rs As Recordset
Dim ID As String
Dim riqi As String
Dim xuhao As String
Dim k1 As String
Dim k2 As String
Dim k3 As String
Dim k4 As String
Dim k5 As String
Dim k6 As String
Dim xufang As String
Dim gongfang As String
Dim caozuoyuan As String
Dim bizhong As String
Dim xiadanri As String
Dim kefushi As String
Dim rel As Integer
OraOpen = False
OraID = "---" 'Oracle数据库的相关配置
OraUsr = "----"
OraPwd = "-----"
ConnStr = "Provider = MSDAORA.1;Password=" & OraPwd & _
";User ID=" & OraUsr & _
";Data Source=" & OraID & _
";Persist Security Info=True"
ConnDB.CursorLocation = adUseServer
ConnDB.Open ConnStr
OraOpen = True '成功执行后,数据库即被打开
For Each rng In Range("A2", [A65536].End(3)).SpecialCells(12)
str = str & "," & rng.Row
Next
str = Mid(str, 2, Len(str) - 1)
For i = 0 To UBound(Split(str, ","))
Cells(i + 2, 100) = Cells(Split(str, ",")(i), 2)
Cells(i + 2, 101) = Cells(Split(str, ",")(i), 5)
Cells(i + 2, 102) = Cells(Split(str, ",")(i), 8)
Cells(i + 2, 103) = Cells(Split(str, ",")(i), 23)
Cells(i + 2, 104) = Cells(Split(str, ",")(i), 25)
Cells(i + 2, 105) = Cells(Split(str, ",")(i), 30)
Next
For k = 0 To UBound(Split(str, ","))
If UBound(Split(str, ",")) > 300 Then
MsgBox "数据超过300行,不能修改!", vbInformation, "提示信息"
Exit For
End If
k1 = Cells(k + 2, 100)
k2 = Cells(k + 2, 101)
k3 = Cells(k + 2, 102)
k4 = Cells(k + 2, 103)
k5 = Cells(k + 2, 104)
k6 = Cells(k + 2, 105)
If k1 = "P0101" Then
SQLRst = "update ROUOPE set OPETIM_0='" & k6 & "' where FCY_0='" & k1 & "' and ITMREF_0='" & k2 & "' and ROUALT_0='" & k4 & "' and YITM_0= '" & k5 & "'"
ConnDB.Execute SQLRst
End If
If k1 <> "P0101" Then
MsgBox "地点无权限!", vbInformation, "提示信息"
Exit For
End If
If k3 <> "10" Then
MsgBox "产品类别无权限!", vbInformation, "提示信息"
Exit For
End If
If k = UBound(Split(str, ",")) Then
MsgBox "恭喜您全部修改成功!", vbInformation, "提示信息"
End If
Next
Set cnn = Nothing
End Sub