0

So I got this code off the internet. The guy who made it said this, "I have done this in SQL Server.If u want to do in Acess Database just create a table name USERS then add two fields name user_name and user_pwd thats it."

I tried that and it didnt work. I dont know what to change in the code to make it access the Access Database named 'USERS'. Can someone help me?

Also, when i run it, i get this error code, "Run-time error '-2147467259 (80004005)': [Microsoft][ODBC Driver Manager] Data source name not found and no default driver specified."

The code in red is what it highlights during the error. I think the error is because I dont have SQL on my computer.

Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
 

Private Sub Command10_Click()
'change password button
Dim ms As Integer
If Combo2.Text = "" Then MsgBox "Select User name", vbInformation, "Password change": Exit Sub

ms = MsgBox("Do you want really Change Password ? '" & Trim(UCase(Combo2.Text)) & "'", vbQuestion + vbYesNo, "Password change")
  
  If Text6.Text = "" Or Text7.Text = "" Then MsgBox "Enter New Password.", vbInformation, "Change Password"
  Text6.SetFocus
 
 If Trim(Text6.Text) <> Trim(Text7.Text) Then
     MsgBox "Password and Confirm Password are not matched.", vbInformation, "Confirm Password"
     Text6.Text = ""
     Text7.Text = ""
     Text6.SetFocus
 End If

If ms = vbYes Then
    Set rs = New ADODB.Recordset
    rs.Open "select *  from USERS where user_name ='" & Trim(UCase(Combo2.Text)) & "'", cn, 1, 2
    rs!user_pwd = Text6.Text
    rs.Update
   
   Text6.Text = ""
   Text7.Text = ""
End If
End Sub

Private Sub Command11_Click()
Frame5.Visible = True
Frame3.Visible = False
End Sub

Private Sub Command12_Click()
'password change ok button
 If Combo2.Text = "" Then MsgBox "Select User Name", vbInformation, "Password Change": Exit Sub
 If Text6.Text = "" Then MsgBox "Enter Password", vbInformation, "Password Change": Exit Sub
 If Text7.Text = "" Then MsgBox "Enter Confirm Password", vbInformation, "Password Change": Exit Sub
 
 If Trim(Text6.Text) <> Trim(Text7.Text) Then
     MsgBox "Password and Confirm Password are not matched.", vbInformation, "Confirm Password"
     
     Text6.Text = ""
     Text7.Text = ""
     Text6.SetFocus
   Else
   
     MsgBox "Your Password Sucessfully Changed", vbInformation, "Password Changed"
 End If
 
    Set rs = New ADODB.Recordset
    rs.Open "select *  from USERS where user_name ='" & Trim(UCase(Combo2.Text)) & "'", cn, 1, 2
    
     rs!user_pwd = Text6.Text
     rs.Update
      Text6.Text = ""
      Text7.Text = ""
       Exit Sub
           End Sub

Private Sub Command2_Click()
'delete user frame5
Combo1.Clear

Set rs = New ADODB.Recordset
rs.Open "select * from USERS order by user_name", cn, 1, 2

     
    If rs.RecordCount <> 0 Then
    
        If rs.EOF = True Then rs.MoveFirst
   
        Do Until rs.EOF
                         
            Combo1.AddItem Trim(rs!user_name)
            rs.MoveNext
        Loop
    End If
Frame2.Visible = True
Frame1.Visible = False
Frame3.Visible = False
'Frame4.Visible = False
Frame5.Visible = False
End Sub

Private Sub Command3_Click()
'change password frame 5
Combo2.Clear
Set rs = New ADODB.Recordset
rs.Open "select * from USERS order by user_name", cn, 1, 2

     
    If rs.RecordCount <> 0 Then
    
        If rs.EOF = True Then rs.MoveFirst
   
        Do Until rs.EOF
                         
            Combo2.AddItem Trim(rs!user_name)
            rs.MoveNext
        Loop
    End If
Frame3.Visible = True
Frame1.Visible = False
Frame2.Visible = False
'Frame4.Visible = False
Frame5.Visible = False
End Sub



Private Sub Command5_Click()
End
End Sub

Private Sub Command4_Click()
Unload Me
End Sub

Private Sub Command6_Click()
'New user ok button
  
 If Text1.Text = "" Then MsgBox "Enter User name", vbInformation, "New User": Exit Sub
 If Text2.Text = "" Then MsgBox "Enter Password", vbInformation, "New User": Exit Sub
 If Text3.Text = "" Then MsgBox "Enter Confirm Password", vbInformation, "New User": Exit Sub
  
 
   'chking if password and conforim are not same
  If Trim(Text2.Text) <> Trim(Text3.Text) Then
     MsgBox "Password and Confirm Password are not matched.", vbInformation, "Confirm Password"
     Text2.Text = ""
     Text3.Text = ""
     Exit Sub
  End If
  Set rs = New ADODB.Recordset
  rs.Open "select * from USERS where user_name ='" & UCase(Trim(Text1.Text)) & "'", cn, 1, 2
  
  'cheking user name already exit or not
  If rs.RecordCount <> 0 Then
     MsgBox "Already there is a user name with '" & UCase(Trim(Text1.Text)) & " ' .", vbExclamation, "New User"
     Text1.Text = ""
     Text2.Text = ""
     Text3.Text = ""
     Exit Sub
  End If
     rs.AddNew
     rs!user_name = UCase(Text1.Text)
     rs!user_pwd = UCase(Text2.Text)
     MsgBox " New User Added", vbInformation
     rs.Update
     Text1.Text = ""
     Text2.Text = ""
     Text3.Text = ""
     Text1.SetFocus

End Sub

Private Sub Command7_Click()
Frame5.Visible = True
Frame1.Visible = False
End Sub

Private Sub Command8_Click()
Dim ms As String
'DELETE
If Combo1.Text = "" Then MsgBox "Select User name", vbInformation, "Delete": Exit Sub
Set rs = New ADODB.Recordset
ms = MsgBox("Do you want really delete this User ? '" & Trim(UCase(Combo1.Text)) & "'.", vbQuestion + vbYesNo, "Delete")

If ms = vbYes Then
    Set rs = New ADODB.Recordset
    rs.Open "delete from  USERS where user_name= '" & Trim(Combo1.Text) & "'", cn, 1, 2
  MsgBox " User Deleted", vbInformation, "Deleted"
   Combo1.Clear
    'combo1
      Set rs = New ADODB.Recordset
      rs.Open "SELECT *  FROM USERS ORDER BY user_name", cn, 1, 2
    If rs.RecordCount <> 0 Then
    
        If rs.EOF = True Then rs.MoveFirst
   
        Do Until rs.EOF
                         
            Combo1.AddItem Trim(rs!user_name)
            rs.MoveNext
        Loop
    End If
End If

End Sub

Private Sub Command9_Click()
Frame2.Visible = False
Frame5.Visible = True
End Sub

    Private Sub Form_Load()
    Set cn = New ADODB.Connection
    cn.Open "dsn=USERS;userid=;pwd=;"
    
    End Sub
    Private Sub Command1_Click()
    Frame1.Visible = True
    Frame2.Visible = False
    Frame3.Visible = False
    'Frame4.Visible = False
    Frame5.Visible = False

End Sub



Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then Text2.SetFocus
End Sub

Private Sub Text2_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then Text3.SetFocus
End Sub
Private Sub Text3_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then Command6.SetFocus
End Sub
Private Sub Text4_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then Text5.SetFocus
End Sub

Private Sub Text5_KeyUp(KeyCode As Integer, Shift As Integer)

  If KeyCode = 13 Then Call Command4_Click
  
End Sub
'If KeyCode = 13 Then Command4.SetFocus
'End Sub

Private Sub Text6_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then Text7.SetFocus
End Sub

Private Sub Text7_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then Command10.SetFocus
End Sub
Private Sub Combo2_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then Text6.SetFocus
End Sub
2
Contributors
2
Replies
3
Views
9 Years
Discussion Span
Last Post by cutepinkbunnies
0

Indeed...your error is coming from 1. lack of a filename in the connection string and 2. no driver specified. That should fix it as long as you can successfully modify it.

This topic has been dead for over six months. Start a new discussion instead.
Have something to contribute to this discussion? Please be thoughtful, detailed and courteous, and be sure to adhere to our posting rules.