I have this assignment where I have to have a login userform that can register new users User names and passwords to a table in an Access database. Whenever I enter information into the two textbox controls and click the register button, I get run-time error "3709": A connection cannot be used to perform this operation. It is either closed or invalid.
This is the line of code that comes up when the debug button is clicked
rst.Open Source:=strquery, ActiveConnection:=cn, _
CursorType:=adOpenForwardOnly, LockType:=adLockOptimistic, Options:=adCmdText
Here are the VBA subs in order with the line of code where it shows the error from above, in BOLD.
This is the line of code that comes up when the debug button is clicked
rst.Open Source:=strquery, ActiveConnection:=cn, _
CursorType:=adOpenForwardOnly, LockType:=adLockOptimistic, Options:=adCmdText
Here are the VBA subs in order with the line of code where it shows the error from above, in BOLD.
Code:
Code:
Dim logincounter As Integer
Dim cn As ADODB.Connection
Dim rst As ADODB.Recordset
Private Sub cmdLogin_Click()
Dim returnsearchoutcome As Boolean 'flag to see if user input a valid userid
Dim ablank As Boolean
returnsearchoutcome = False
Call blankcheck(ablank, "1")
If ablank Then
MsgBox "You must enter data in both returning user login fields." 'login attempt count does not go down in this version if blanks
Else
If logincounter < 2 Then 'recall logincounter starts at 0 in this code
Call searchforit(returnsearchoutcome, "returning", CStr(txtUserID.Value), CStr(txtPassword.Value))
'cstr data conversion used to convert all input to strings for this code example
If returnsearchoutcome Then
Call moving_on(CStr(txtUserID.Value))
End If
Else
Call closedatabase
Unload Me
End If
End If
End Sub
Private Sub cmdRegister_Click()
Dim registersearchoutcome As Boolean 'flag to see if user input a new userid
Dim ablank As Boolean
registersearchoutcome = False
Call blankcheck(ablank, "2")
If ablank Then
MsgBox "You must enter data in both new user registration fields."
Else
Call searchforit(registersearchoutcome, "register", CStr(txtNewUser.Value))
'cstr data conversion used to convert all input to strings for this code example
If registersearchoutcome Then
Call register_addnewrecord
Call moving_on(CStr(newuserid.Value))
'cstr data conversion used to convert all input to strings for this code example
End If
End If
End Sub
Public Sub initialize()
'Following lines create the database connection
Set cn = New ADODB.Connection 'Recall that when you dim an object then you need to SET it before you can use it.
With cn 'The with piece of code below sets the provider property and the connection string
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & ThisWorkbook.Path & Application.PathSeparator & "Inventory.accdb;"
.Open 'cn.open uses the connection details to actually open the database
End With
End Sub
Private Sub searchforit(ByRef successflag As Boolean, ByVal searchtype As String, userstring As String, Optional pwordstring As String)
'this sub uses the database connection and a recordset command to
'search the database for the user id and password
'reminder that you can pass required arguments or optional arguments, and either byref or byval
'see illustration above
Dim strquery As String
Application.EnableEvents = False 'turn off events while Excel interacts with database
strquery = "SELECT UserInfo.UserID, UserInfo.Password FROM UserInfo WHERE UserID = '" & userstring & "'"
'line above creates a string of SQL code that can be created using user input of userid variable value
Call openrecordset 'call the sub to set up the recordset
'the method below opens the recordset and populates it based on the sql query results
'and denotes arguments, such as only move cursor forward, etc.
[B]rst.Open Source:=strquery, ActiveConnection:=cn, _[/B]
[B] CursorType:=adOpenForwardOnly, LockType:=adLockOptimistic, Options:=adCmdText[/B]
If searchtype = "returning" Then 'if this is a returning user (so name should exist in database)
If rst.EOF Then 'if the recordset cursor has moved through all records to the end of the file and not found user
Call errorfeedback
ElseIf rst.Fields("Password").Value <> pwordstring Then 'if the password entered does not equal the password stored in the database
Call errorfeedback
Else
successflag = True
End If
End If
If searchtype = "register" Then 'if this is a new user (so name must be added to database)
If rst.EOF Then 'if the recordset cursor has moved through all records to the end of the file and not found user name requested
successflag = True
Else
MsgBox "That userid is already in use. Please try another."
txtNewUser.Value = ""
End If
End If
Call closerecordset
End Sub
Private Sub register_addnewrecord()
'this sub uses the database connection to add a new record
'notice no recordset is needed here, because you are not searching the database--
'just using connection to database and passing SQL string to add record
'following code takes user input and stores the data in variables
auserid = txtNewUser.Value
apword = txtNewPW.Value
'below creates SQL string that will insert new record once it is executed
strquery = "Insert Into UserInfo (UserID, Password) " & _
"Values ('" & auserid & "','" & apword & "'"
cn.Execute strquery 'executes sql string created above
End Sub
Private Sub errorfeedback()
'this sub displays error message, increases login counter by 1, then clears controls
MsgBox ("Invalid login.")
logincounter = logincounter + 1
loginpassword.Value = ""
loginuserid.Value = ""
End Sub
Private Sub blankcheck(ByRef ablank As Boolean, ByVal whichframe As String)
'thought question---why does byval make sense for one and byval for the other?
'this sub checks to see if form fields are left blank
Dim cCont As Control
ablank = False
For Each cCont In Me.Controls
'to loop through each control to check for a null value
If TypeName(cCont) = "TextBox" And cCont.Parent.Name = "Frame" & whichframe Then
'userform design contains two frames, each with text boxes (see text if you can not recall userform frame use)
'This if only checks control if control is text box and if the text box is located with a certain frame
If cCont.Value = "" Then
ablank = True
End If
End If
Next cCont
End Sub
Private Sub moving_on(ByVal userid As String)
'this sub initializes the next form, passes userid to next userform, and unloads the login form
frmMain.initialize (userid)
Call closedatabase
Unload Me
frmMain.Show
End Sub
Private Sub closedatabase()
'This sub closes the database connection and releases memory
cn.Close 'close the open SQL/Access connection
Set cn = Nothing 'removes the object from memory
End Sub
Private Sub closerecordset()
rst.Close 'closes the recordset which releases the memory structures that stored the recordset
Set rst = Nothing 'clears the pointer to that memory structure (the memory the recordset used)
End Sub
Private Sub openrecordset()
Set rst = New ADODB.Recordset 'sets the recordset object to the database content
rst.CursorLocation = adUseServer 'Tells the cursor to move through the server, which is the database (Excel is the client)
'the cursor location command must be sent before the recordset is opened
End Sub