vb中修改密码问题

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Private Sub Command1_Click()
If Trim(Text1.Text) = "" Then
   MsgBox "请输入原密码"
   Text1.SetFocus
    Exit Sub
End IfIf Trim(Text2.Text) = "" Then
   MsgBox "请输入新密码！"
   Text2.SetFocus
   Exit Sub
End If
If Trim(Text3.Text) = "" Then
   MsgBox "请再次输入新密码！"
   Text2.SetFocus
   Exit Sub
End If
Set cn = New ADODB.Connection
cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\dm.mdb;Persist Security Info=False"
cn.Open
Set rs = New ADODB.Recordset
Dim sql As String
sql = "select passwd from [user] where [passwd]='" & Text1.Text & "'"
rs.Open sql, cn, 3, 1
If rs.EOF Then
     MsgBox "原密码输入错误，请重新输入！", vbOKOnly + vbQuestion, "警告"
     Text1.SetFocus
     Text1.Text = ""
End If
rs.Close
Dim str As String
str = "update [user] set [passwd]= '" & Trim(Text2.Text) & " ' where passwd='" & Trim(Text1.Text) & "'"
If Trim(Text2.Text) = Trim(Text3.Text) Then
 rs.Open str, cn, 3, 1
     MsgBox "密码修改成功！"
     Unload Me
     
Else
    MsgBox "两次密码输入不一致，请重新输入"
    Text2.Text = ""
    Text3.Text = ""
    Text2.SetFocus
End IfEnd Sub
这是一个修改密码的代码，我的本意是，输入原密码后，两次输入新密码，如果原密码和新密码不为空，而原密码输入正确，两次输入新密码都相同的话是，显示密码修改成功。
但我这段代码有问题，总不能实现，请大家帮我看看。