Question

VB中关于Recordset.update 的问题。求教！

代码如下。简单描述一下，功能是修改密码用的，在password 表中，一个帐号存在多条记录，密码是相同的，修改密码的话会同时更新该帐号所有的记录。
问题是这样的：执行上面的程序，数据库中的记录没有被更新。程序也不报错。
Private Sub cmdOK_Click()
Dim strSQL As String
Dim rst As ADODB.Recordset
frmLogin.MousePointer = 11
strSQL = "select * from password where password001 = '" & txtUserID.Text & "'"
Set rst = CreateRecordset(conn, strSQL)
If Err.Number <> 0 Then
frmLogin.MousePointer = 0
MsgBox "修改密码时，开启数据库失败！" & Chr(13) & "错误描述：" & Err.Description
Exit Sub
End If
If rst.RecordCount > 0 Then
rst.MoveFirst
While Not rst.EOF

' MsgBox rst.Fields("password002").Value
If rst.Fields("password002").Value = txtOPassword.Text Then
If txtNPassword1.Text = txtNPassword2.Text Then
rst.Fields("password002").Value = txtNPassword1.Text
Else
frmLogin.MousePointer = 0
MsgBox "请确认新密码是否相同!!!", 48, "警告"
Exit Sub
End If
Else
frmLogin.MousePointer = 0
MsgBox "密码错误!!!" & Chr(13) & "请注意大小写!!!", 48, "警告"
Exit Sub
End If
rst.MoveNext
Wend
rst.UpdateBatch
Else
frmLogin.MousePointer = 0
MsgBox "系统内没有你的帐号!!!", 48, "警告"
Exit Sub
End If

frmLogin.MousePointer = 0

MsgBox "更新成功!!!", 48, "提示"
frmEditPassword.Hide
frmMain.Show
End Sub

Public Function CreateRecordset(ByRef aConn As ADODB.Connection, ByVal aSQLString As String) As ADODB.Recordset
On Error GoTo suberrhdl
Dim theRecordSet As ADODB.Recordset
If UCase(Trim(TypeName(aConn))) <> "CONNECTION" Then
Exit Function
End If
Set theRecordSet = New ADODB.Recordset
theRecordSet.CursorLocation = adUseClient
Set theRecordSet.ActiveConnection = aConn
' theRecordSet.CursorType = adOpenStatic
theRecordSet.CursorType = adUseClient
' theRecordSet.LockType = adLockPessimistic
theRecordSet.LockType = adLockBatchOptimistic
theRecordSet.Source = aSQLString
theRecordSet.Open
Set theRecordSet.ActiveConnection = Nothing
Set CreateRecordset = theRecordSet
Exit Function
suberrhdl:
If Not aConn Is Nothing Then
Set aConn = Nothing
End If
End Function
当我这样写道时候就可以更新
Dim rst As New ADODB.Recordset
frmLogin.MousePointer = 11
strSQL = "select * from cppassword where cppassword001 = '" & txtUserID.Text & "'"
‘ Set rst = CreateRecordset(conn, strSQL)
rst.Open strSQL, conn, 3, 4, adCmdText
但这个程序并不是只有这个功能，其他功能也会UPDATE，会调用到CreateRecordset这个方法

Answer 1

你的这个程序看起来头大：
1、CreateRecordset中的这条语句Set theRecordSet.ActiveConnection = Nothing将theRecordSet关闭了，那么rst就是Nothing，根本无法调用，这是你问题的根本。
2、rst.MoveFirst是多余的，ADODB.Recordset在Open后就在First处，不用再Move，除非你用了Move、MoveNext、MoveLast等方法Move了游标。
3、批量的修改建议用SQL的Update语句，比如：rst.open "update password set 。。。 where 。。。
4、你在MsgBox后直接Exit Sub了，rst没有Close，这是一个很不好的习惯，另外直接Exit Sub了，frmLogin.MousePointer也没有改为0。
5、If Err.Number <> 0 Then的判断是否应该放在CreateRecordset，因为你每次CreateRecordset后都要判断是否连接成功的。
6、If txtNPassword1.Text = txtNPassword2.Text Then，该判断应放在ADODB.Recordset的Open即CreateRecordset之前，如果俩密码不一致，直接提示，一致后再进行数据库的操作。
7、strSQL = "select * from password where password001 = '" & txtUserID.Text & "'"，如果 txtUserID.Text 中包含有单引号，该语句将出错。 txtUserID.Text 是用户输入的，是你不可控的：Replace(txtUserID.Text ,"'","")。

追问

非常感謝你指出程序中的一些毛病。同時，
Set theRecordSet.ActiveConnection = Nothing
这个仿佛是问题所在，但我将它注释起来，确实能达到更新的效果，可有个问题想请教一下，当使用Set theRecordSet.ActiveConnection = Nothing时，theRecordSet会关闭吗？那为什么 MsgBox rst.Fields("password002").Value时，是有值的呢。

Answer 2

Set theRecordSet.ActiveConnection = Nothing 这一句为将记录集设定为离线记录集，不支持更新，如果想更新在
strSQL = "select * from password where password001 = '" & txtUserID.Text & "'"
Set rst = CreateRecordset(conn, strSQL)
此处加上：Set theRecordSet.ActiveConnection = conn 这样应该就可以了

Answer 3

你的程序编写习惯不大好，容易从思路上乱
Private Sub cmdOK_Click()
Dim strSQL As String
Dim rst As ADODB.Recordset
frmLogin.MousePointer = 11
strSQL = "select * from password where password001 = '" & txtUserID.Text & "'"
Set rst = CreateRecordset(conn, strSQL)
If Err.Number <> 0 Then
frmLogin.MousePointer = 0
MsgBox "修改密码时，开启数据库失败！" & Chr(13) & "错误描述：" & Err.Description
Exit Sub
End If
If rst.RecordCount > 0 Then
rst.MoveFirst
While Not rst.EOF

' MsgBox rst.Fields("password002").Value
If rst.Fields("password002").Value = txtOPassword.Text Then
If txtNPassword1.Text = txtNPassword2.Text Then
rst.Fields("password002").Value = txtNPassword1.Text
Else
frmLogin.MousePointer = 0
MsgBox "请确认新密码是否相同!!!", 48, "警告"
Exit Sub
End If
Else
frmLogin.MousePointer = 0
MsgBox "密码错误!!!" & Chr(13) & "请注意大小写!!!", 48, "警告"
Exit Sub
End If
在这里加一句rst.Updata
rst.MoveNext
Wend
' rst.UpdateBatch 把这一句删掉，试试
Else
frmLogin.MousePointer = 0
MsgBox "系统内没有你的帐号!!!", 48, "警告"
Exit Sub
End If

frmLogin.MousePointer = 0

MsgBox "更新成功!!!", 48, "提示"
frmEditPassword.Hide
frmMain.Show
End Sub

Public Function CreateRecordset(ByRef aConn As ADODB.Connection, ByVal aSQLString As String) As ADODB.Recordset
On Error GoTo suberrhdl
Dim theRecordSet As ADODB.Recordset
If UCase(Trim(TypeName(aConn))) <> "CONNECTION" Then
Exit Function
End If
Set theRecordSet = New ADODB.Recordset
theRecordSet.CursorLocation = adUseClient
Set theRecordSet.ActiveConnection = aConn
' theRecordSet.CursorType = adOpenStatic
theRecordSet.CursorType = adUseClient
' theRecordSet.LockType = adLockPessimistic
theRecordSet.LockType = adLockBatchOptimistic
theRecordSet.Source = aSQLString
theRecordSet.Open
Set theRecordSet.ActiveConnection = Nothing 记录集刚刚打开为什么要关闭连接？
Set CreateRecordset = theRecordSet
Exit Function
suberrhdl:
If Not aConn Is Nothing Then
Set aConn = Nothing
End If
End Function
问题补充：
当我这样写道时候就可以更新
Dim rst As New ADODB.Recordset
frmLogin.MousePointer = 11
strSQL = "select * from cppassword where cppassword001 = '" & txtUserID.Text & "'"
‘ Set rst = CreateRecordset(conn, strSQL)
rst.Open strSQL, conn, 3, 4, adCmdText

Answer 4

在rst.Fields("password002").Value = txtNPassword1.Text
前加上
rst.Recordset.Edit
rst.Fields("password002").Value = txtNPassword1.Text

追问

这样不行。

追答

这是我自己的一个修改密码的函数，自己参考吧
Private Function fun_用户资料修改(f As Long, fr As String, x As Long, xr As String, xinnr As String) As Boolean
Dim i, j As Long
Dim a() As String
Dim ls As Long
ls = Data1.Recordset.Fields.Count

ReDim a(ls)
For j = 0 To ls - 1
a(j) = ""
Next j
'On Error GoTo er
If x = 1 Then '判断是否为修改密码
For i = 0 To yonghuzongshu - 1
If fr = Data1.Recordset.Fields(f).Value And xr = shujujiemi(Data1.Recordset.Fields(x).Value, "c") Then
For j = 0 To ls - 1
If j x Then a(j) = Data1.Recordset.Fields(j).Value
Next j
Data1.Recordset.Edit
a(x) = shujujiami(xinnr, "c")
For j = 0 To ls - 1
Data1.Recordset.Fields(j).Value = a(j)
Next j
Data1.Recordset.Update
Data1.Refresh
fun_用户资料修改 = True
Exit Function
End If
Data1.Recordset.MoveNext
Next i
Else
For i = 0 To yonghuzongshu - 1
If fr = Data1.Recordset.Fields(f).Value And xr = Data1.Recordset.Fields(x).Value Then
For j = 0 To ls - 1
a(j) = Data1.Recordset.Fields(j).Value
Next j
Data1.Recordset.Edit
a(x) = xinnr
For j = 0 To ls - 1
Data1.Recordset.Fields(j).Value = a(j)
Next j
Data1.Recordset.Update
Data1.Refresh
fun_用户资料修改 = True
Exit Function
End If
Data1.Recordset.MoveNext
Next i
End If
Exit Function
'er:
fun_用户资料修改 = False
End Function

追问

请问下Data1是什么？是ADODB.Recordset对象？但是我这里不能写成Data1.Recordset.MoveNext这种形式，只能写成Data1.MoveNext，我用的VB6.0.

追答

我也是呀

Answer 5

.CursorLocation = adUseClient 这个在开始的时候就该告诉计算机

追问

告诉计算机啥？
我想问下解决办法。

追答

代码就是指令的集合
.CursorLocation = adUseClient 就是告诉计算机你是在客户端操作数据库，不是在服务器端
应该放在开始 Dim rst As ADODB.Recordset的后面