I have a login screen which compares data via a Dlookup in order to authenticate users. I would like to create a global variable upon a correct login that any form on the database can call on and then open a form based on what that value is. So currently I have everything set up as such.
LOGIN FORM :
Option Compare Database
Public gstrUsr As String
LOGIN FORM:
Public Sub Command4_Click()
'Sets the login time to now and then authenticates user credentials
Dim usr As String
Me.Time = Now
Dim lvl As String
Dim lck As Integer
Dim sql As String
Dim msgapp As Integer
Dim chkusr As Variant
chkusr = Nz(DLookup("[Username]", "Login", "[Username]='" & Me.Username.Value & "'"), "")
msgapp = 0
usr = Nz(DLookup("[Password]", "Login", "[Username]='" & Me.Username.Value & "'"), "")
lvl = Nz(DLookup("[Level]", "Login", "[Username]='" & Me.Username.Value & "'"), "")
sql = "INSERT INTO Log ( [User], [Time] )SELECT [Forms]![Login]![Username] AS Expr1, [Forms]![Login]![Time] AS Expr2;"
''" & [Forms]![ItemList1]![SRCB] & "'"
'Runs above sql which adds a time record for the selected username also removes the "You are about to update X rows", will use this in the future on the accounting functions
If chkusr = "" Then msgapp = 1
If chkusr = "" Then MsgBox ("Invalid Credentials")
DoCmd.SetWarnings False
DoCmd.RunSQL (sql)
DoCmd.SetWarnings True
'If password is = to the value that is returned in the "usr" variable declared at the top via Dlookup it will open a form based on what that users "level" is otherwise displays and invalid credentials message box
Do While msgapp = 0
If usr = Me.Password.Value Then
lck = 1
msgapp = 3
Else
MsgBox ("Invalid Credentials")
msgapp = 3
End If
Loop
Do While lck = 1
If lvl = "2" Then
DoCmd.OpenForm "MainB"
gstrUsr = DLookup("[Username]", "Login", "[Username]='" & Me.Username & "'")
lck = 0
Else
DoCmd.OpenForm "Main"
lck = 0
End If
Loop
End Sub
FORM THAT LOADS AFTER SUCCESSFUL LOGIN: (Main form with buttons to get to other forms, I included a text box so I could see if the information is being passed to the second form)
Private Sub Form_Load()
Me.Text75 = gstrUsr
End Sub
How do I get the global variable to pass to the second form?
Define your public variable in a code module instead of the module of the form.
This way it'll be available from any module (if it's public)
Related
I am trying to pull in column data from a table into a timer in VBA. In my table I have IntervalSeconds as a number. I'm trying to query the number of seconds to determine how long to set my counter for.
Dim timeRemaining As Long (Form Variable) - used in multiple functionss
Private Sub Form_Open(Cancel As Integer)
Dim strSQL As String
Me.Visible = False
strSQL = "SELECT AccessControl.IntervalSeconds FROM AccessControl WHERE AccessControl.DatabaseName = '" & CurrentDb.Name & "'"
timeRemaining = CLng(strSQL)
DoCmd.OpenForm ("frmForceLogout")
End Sub
Every time I run the form I get a Type Mismatch error when I hit the timeRemaining = cLng(strSQL) line. Am I missing something?
You can use DLookup for such simple tasks:
Private Sub Form_Open(Cancel As Integer)
Dim Criteria As String
Me.Visible = False
Criteria = "DatabaseName = '" & CurrentDb.Name & "'"
timeRemaining = DLookup("IntervalSeconds", "AccessControl", Criteria)
DoCmd.OpenForm ("frmForceLogout")
End Sub
I have got this code below that restricts users to leave an empty field in a form. Now I want to use this in all of my forms. I've tried to use in Public Subroutine using a module. But it doesn't work.
Private Sub Form_BeforeUpdate(Cancel As Integer)
Dim msg As String, Style As Integer, Title As String
Dim nl As String, ctl As Control
nl = vbNewLine & vbNewLine
For Each ctl In Me.Controls
If ctl.ControlType = acTextBox Then
If ctl.Tag = "*" And Trim(ctl & "") = "" Then
msg = "Data Required for '" & ctl.Name & "' field!" & nl & _
"You can't save this record until this data is provided!" & nl & _
"Enter the data and try again . . . "
Style = vbCritical + vbOKOnly
Title = "Required Data..."
MsgBox msg, Style, Title
ctl.SetFocus
Cancel = True
Exit For
End If
End If
Next
End Sub
I just want to use this in all of my forms. How do I accomplish this?
Good question, and good idea.
So, keep in mind that "me" is just the current form you are working with.
So, create a plane jane standard code module. And drop in your function like this with a "few" changes.
Public Function CheckRequired(MyMe As Form) As Boolean
Dim msg As String
Dim Style As Integer
Dim Title As String
Dim nl As String
Dim ctl As Control
nl = vbCrLf ' crlf gives you one line
CheckRequired = False ' assume everything ok
For Each ctl In MyMe.Controls
If ctl.ControlType = acTextBox Then
If ctl.Tag = "*" And Trim(ctl & "") = "" Then
msg = "Data Required for '" & ctl.Name & "' field!" & nl & _
"You can't save this record until this data is provided!" & nl & _
"Enter the data and try again . . . "
Style = vbCritical + vbOKOnly
Title = "Required Data..."
MsgBox msg, Style, Title
ctl.SetFocus
CheckRequired = True
Exit Function
End If
End If
Next
End Function
Now, in the forms event (which has that cancel), then you do this:
Private Sub Form_BeforeUpdate(Cancel As Integer)
Cancel = CheckRequired(Me)
End Sub
As #June7 mentioned, Me is only valid behind forms and reports. It is shorthand alias for the form/report name/object. To achieve what you are looking for, you can try this concept. Create the global routine like below :
Public Function Validate_BeforeUpdate(frm As Form) As Integer
Dim msg As String, Style As Integer, Title As String
Dim nl As String, ctl As Control
nl = vbNewLine & vbNewLine
For Each ctl In frm.Controls
'''' your other code
Validate_BeforeUpdate = 1
Exit For
Next
End Sub
And to use this from your other forms, do it like below :
Private Sub Form_BeforeUpdate(Cancel As Integer)
If Validate_BeforeUpdate(Me) = 1 Then
Cancel = True
End If
End Sub
This is not a tested code, if you follow this idea, you should be okay to have what you are trying to do.
I am creating a user login system using vb.net and MS access. I am unsure what is going wrong with my system and I receive the error message "Item cannot be found in the collection corresponding to the requested name or ordinal" The error is coming up in the section "User.Find(Username)" on the first line of the DO loop. Here is my code:
Public Class Login
Dim LoginError As String ' This will tell the user what is wrong with his login
Public Function Login()
Dim DBConn As New ADODB.Connection ' This is how we tell visual studio
'how to connect to our database
Dim User As New ADODB.Recordset 'We pass our argument through our recordset
Dim Username As String 'This will be our "Query"
Dim strUserDB As String 'This get sets to the email field in our database.
Dim strPassDB As String 'Same as above just for the password
Dim blnUserFound As Boolean 'I will be using a "DO" loop so I will use
'this as my condition
DBConn.Open("Provider = Microsoft.Jet.OLEDB.4.0;" & _
"Data Source = '" & Application.StartupPath & "\UserDetails2000.mdb'")
'The inverted comas in the dataOuce statement as itt keeps the location of your
'file as one string.
User.Open("tblUserDetails", DBConn, ADODB.CursorTypeEnum.adOpenStatic, ADODB.LockTypeEnum.adLockOptimistic)
'This is my table 'This is my connection 'These are some settings
blnUserFound = False
Login = False
Username = "User = '" & txtEmail.Text & "'" 'This tells the database to find the email field
'Equivilent to what was entered in the textbox
Do
User.Find(Username) 'This is the full statement that sends my 'Query' to the record set
If User.BOF = False And User.EOF = False Then
'BOF = Begining of file, EOF = End of file, it tests whether the database has
'reached its sentinal value, if it hasent then the username has been found, If it has,
'the username has been found.
strUserDB = User.Fields("Email").Value.ToString
'"Email" is my table field. I am setting strUserDB to the username field of my table
strPassDB = User.Fields("Password").Value.ToString
If strUserDB <> txtEmail.Text Then
User.MoveNext()
'This IF statement handles different CASE usernames, Example, admin and AdMiN
'We use this if statement to differentiate between different CASE letters
Else
blnUserFound = True
If strPassDB = txtPassword.Text Then
User.Close()
DBConn.Close()
Return True
Else
LoginError = "Invalid Password"
User.Close()
DBConn.Close()
Return False
End If
End If
Else
LoginError = "Invalid Username"
User.Close()
DBConn.Close()
Return False
End If
Loop Until blnUserFound = True
LoginError = "Invalid Username"
User.Close()
DBConn.Close()
Return False
End Function
Private Sub btnLogin_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnLogin.Click
If Login() = True Then
MessageBox.Show("Login Succesful", "Login Status")
Else
MessageBox.Show(LoginError, "Login Status")
End If
End Sub
End Class
Verify that tblUserDetails contains a column named User.
Maybe User is also a reserved keyword in Access so try setting Username as:
Username = "[User] = '" & txtEmail.Text & "'"
I'm trying to set up my form program so if the user fails to login 3 times (linked to a database), it closes the program. However, I'm a kinda crap at programming and I can't get the variable to actually hold the addition I'm trying to use?
Private Sub Login_Click(sender As Object, e As EventArgs) Handles Login.Click
Dim uname, pass As String
Dim attempt As Integer = 0
' Warns the user if they have missed out login information.
If UserNameBox.Text = "" Or PasswordBox.Text = "" Then
MessageBox.Show("Please ensure you have entered your username and password", "Authentication Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
Else
uname = UserNameBox.Text
pass = PasswordBox.Text
GetFilteredData("username = '" & uname & "' AND password = '" & pass & "'")
If CountRecords() = 1 Then
MsgBox("Logged In!")
Else
MsgBox("Incorrect Credentials!")
attempt = attempt + 1 ' <-- Main Issue is here
If attempt = 4 Then
Application.Exit()
End If
End If
End If
End Sub
Any help would be amazing. Thanks :D
You're declaring on the attempt varible inside the Login_Click event handler. Hence, each time the Login_Click event is raised, you are initializing it to 0.
Dim attempt As Integer = 0
Try to move it to outer scope, for example make it a member of the Class.
This should work. If you want to have variable accessible from all subs, just take it out too root of class.
Private attempt As Integer = 0
Private Sub Login_Click(sender As Object, e As EventArgs) Handles Login.Click
Dim uname, pass As String
' Warns the user if they have missed out login information.
If UserNameBox.Text = "" Or PasswordBox.Text = "" Then
MessageBox.Show("Please ensure you have entered your username and password", "Authentication Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
Else
uname = UserNameBox.Text
pass = PasswordBox.Text
GetFilteredData("username = '" & uname & "' AND password = '" & pass & "'")
If CountRecords() = 1 Then
MsgBox("Logged In!")
Else
MsgBox("Incorrect Credentials!")
attempt = attempt + 1 ' <-- Main Issue is here
If attempt = 4 Then
Application.Exit()
End If
End If
End If
End Sub
I have a fairly straightforward question. I am trying to find a way to alter and change a connection string for an existing data connection in an excel workbook through VBA (macro code). The main reason I am trying to do this is to find a way to prompt the user that opens up the workbook to enter their credentials (Username/Password) or have a checkbox for Trusted Connection that would be used in the Connection String of those existing data connections.
Right now the Data connections are running off a sample user that I created and that needs to go away in the production version of the workbook. Hope that makes sense?
Is this possible? If yes, could you please give me a sample/example code block? I would really appreciate any suggestions at this point.
I also had this exact same requirement and although the duplicate question Excel macro to change external data query connections - e.g. point from one database to another was useful, I still had to modify it to meet the exact requirements above. I was working with a specific connection, while that answer targeted multiple connections. So, I've included my workings here. Thank you #Rory for his code.
Also thanks to Luke Maxwell for his function to search a string for matching keywords.
Assign this sub to a button or call it when the spreadsheet is opened.
Sub GetConnectionUserPassword()
Dim Username As String, Password As String
Dim ConnectionString As String
Dim MsgTitle As String
MsgTitle = "My Credentials"
If vbOK = MsgBox("You will be asked for your username and password.", vbOKCancel, MsgTitle) Then
Username = InputBox("Username", MsgTitle)
If Username = "" Then GoTo Cancelled
Password = InputBox("Password", MsgTitle)
If Password = "" Then GoTo Cancelled
Else
GoTo Cancelled
End If
ConnectionString = GetConnectionString(Username, Password)
' MsgBox ConnectionString, vbOKOnly
UpdateQueryConnectionString ConnectionString
MsgBox "Credentials Updated", vbOKOnly, MsgTitle
Exit Sub
Cancelled:
MsgBox "Credentials have not been changed.", vbOKOnly, MsgTitle
End Sub
The GetConnectionString function stores the connection string that you insert your username and password into. This one is for an OLEDB connection and is obviously different depending on the requirements of the Provider.
Function GetConnectionString(Username As String, Password As String)
Dim result As Variant
result = "OLEDB;Provider=Your Provider;Data Source=SERVER;Initial Catalog=DATABASE" _
& ";User ID=" & Username & ";Password=" & Password & _
";Persist Security Info=True;Extended Properties=" _
& Chr(34) & "PORT=1706;LOG=ON;CASEINSENSITIVEFIND=ON;INCLUDECALCFIELDS=ON;" & Chr(34)
' MsgBox result, vbOKOnly
GetConnectionString = result
End Function
This code does the job of actually updating a named connection with your new connection string (for an OLEDB connection).
Sub UpdateQueryConnectionString(ConnectionString As String)
Dim cn As WorkbookConnection
Dim oledbCn As OLEDBConnection
Set cn = ThisWorkbook.Connections("Your Connection Name")
Set oledbCn = cn.OLEDBConnection
oledbCn.Connection = ConnectionString
End Sub
Conversely, you can use this function to get whatever the current connection string is.
Function ConnectionString()
Dim Temp As String
Dim cn As WorkbookConnection
Dim oledbCn As OLEDBConnection
Set cn = ThisWorkbook.Connections("Your Connection Name")
Set oledbCn = cn.OLEDBConnection
Temp = oledbCn.Connection
ConnectionString = Temp
End Function
I use this sub to refresh the data when the workbook is opened but it checks that there is a username and password in the connection string before doing the refresh. I just call this sub from the Private Sub Workbook_Open().
Sub RefreshData()
Dim CurrentCredentials As String
Sheets("Sheetname").Unprotect Password:="mypassword"
CurrentCredentials = ConnectionString()
If ListSearch(CurrentCredentials, "None", "") > 0 Then
GetConnectionUserPassword
End If
Application.ScreenUpdating = False
ActiveWorkbook.Connections("My Connection Name").Refresh
Sheets("Sheetname").Protect _
Password:="mypassword", _
UserInterfaceOnly:=True, _
AllowFiltering:=True, _
AllowSorting:=True, _
AllowUsingPivotTables:=True
End Sub
Here is the ListSearch function from Luke. It returns the number of matches it has found.
Function ListSearch(text As String, wordlist As String, seperator As String, Optional caseSensitive As Boolean = False)
Dim intMatches As Integer
Dim res As Variant
Dim arrWords() As String
intMatches = 0
arrWords = Split(wordlist, seperator)
On Error Resume Next
Err.Clear
For Each word In arrWords
If caseSensitive = False Then
res = InStr(LCase(text), LCase(word))
Else
res = InStr(text, word)
End If
If res > 0 Then
intMatches = intMatches + 1
End If
Next word
ListSearch = intMatches
End Function
Finally, if you want to be able to remove the credentials, just assign this sub to a button.
Sub RemoveCredentials()
Dim ConnectionString As String
ConnectionString = GetConnectionString("None", "None")
UpdateQueryConnectionString ConnectionString
MsgBox "Credentials have been removed.", vbOKOnly, "Your Credentials"
End Sub
Hope this helps another person like me that was looking to solve this problem quickly.