Access How do i hard code in a username and password - vba

I am not a coder, but I enjoy tinkering.
I have a access database and I have a login screen, but I want to hard code in a high level username and password into the actual code. The username will be "Developer" the password initially will be "One"
This is what I am doing currently. any assistance would be greatly appreciated.
Private Sub cmdLogin_Click()
On Error GoTo cmdLogin_ClickErr
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset("Select * From TLKPeople Where Username = '" & Me.txtUserName & "' And Password = '" & Me.txtPassword & "'")
If Not rs.EOF Then
TempVars.Add "UserName", rs!UserName.Value
TempVars.Add "Password", rs!Password.Value
TempVars.Add "Admin", rs!Admin.Value
TempVars.Add "ReadOnly", rs!ReadOnly.Value
TempVars.Add "StdUser", rs!STDUser.Value
If Nz(TempVars!UserName, 0) = "Developer" Then
DoCmd.ShowToolbar "Ribbon", acToolbarYes
End If
DoCmd.Close acForm, Me.Name
DoCmd.OpenForm "FRMMenuMain"
DoEvents
Else
MsgBox "Your login as failed!", vbOKOnly, "Login Failed"
End If
rs.Close
Set rs = Nothing
Exit Sub
cmdLogin_ClickErr:
MsgBox ("Err: " & Err.Number & " " & Err.Description)
End Sub

Based on that, this should at least get your started. You will probably need to tweak it a little.
Private Sub cmdLogin_Click()
On Error GoTo cmdLogin_ClickErr
If Len(Me.txtUserName) = 0 And Len(Me.txtPassword) = 0 Then
TempVars.Add "UserName", "Developer"
TempVars.Add "Password", "One"
Else
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset("SELECT * FROM TLKPeople WHERE Username='" & Me.txtUserName & "' And Password='" & Me.txtPassword & "'")
If Not rs.EOF Then
TempVars.Add "UserName", rs!UserName.Value
TempVars.Add "Password", rs!Password.Value
TempVars.Add "Admin", rs!Admin.Value
TempVars.Add "ReadOnly", rs!ReadOnly.Value
TempVars.Add "StdUser", rs!STDUser.Value
Else
MsgBox "Your login as failed!", vbOKOnly, "Login Failed"
Exit Sub
End If
rs.Close
Set rs = Nothing
End If
If Nz(TempVars!UserName, 0) = "Developer" Then
DoCmd.ShowToolbar "Ribbon", acToolbarYes
End If
DoCmd.Close acForm, Me.Name
DoCmd.OpenForm "FRMMenuMain"
DoEvents
Exit Sub
cmdLogin_ClickErr:
MsgBox ("Err: " & Err.Number & " " & Err.Description)
End Sub
Note: You may want to use an Or instead:
If Len(Me.txtUserName) = 0 Or Len(Me.txtPassword) = 0 Then

Related

How to handle errors on broken table links

I have recently updated my linked tables to use UNC links. However when I test the front end using a machine which does not have the mapped drives,
my error handling procedure fails in line Set rs = CurrentDb.OpenRecordset("SELECT ItemName FROM tblDonatedItems") with error number 3044
Is there a way of trapping the error so that the procedure can keep running? Please see below:
Private Sub Form_Load()
On Error Resume Next
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT ItemName FROM tblDonatedItems")
If Err.Number <> 0 Then
MsgBox "Error Number: " & Err.Number & " " & Err.Description & " Please link to backend file!", , "Locate backend file"
Call AttachDataFile
End If
rs.Close
Set rs = Nothing
DoCmd.Close acForm, Me.Name
DoCmd.OpenForm "frmSplash"
End Sub
I have also tried this without success:
Private Sub Form_Load()
On Error GoTo ErrorHandler
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT ItemName FROM tblDonatedItems")
ErrorHandler:
If Err.Number <> 0 Then
MsgBox "Error Number: " & Err.Number & " " & Err.Description & " Please link to backend file!", , "Locate backend file"
Call AttachDataFile
rs.Close
Set rs = Nothing
DoCmd.Close acForm, Me.Name
DoCmd.OpenForm "frmSplash"
Else: MsgBox ("Error! Please email: info#abc.com Quoting Error Number: " & " Err.Number"), vbCritical
DoCmd.OpenForm "frmSplash"
End If
End Sub

MSAccess login form

I created a login form but realized that i can log in without entering a password. only a user name. what should i do so as to solve the problem
Option Compare Database
Option Explicit
Private Sub cmdlogin_Click()
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset("Account Details", dbOpenSnapshot, dbReadOnly)
rs.FindFirst "UserName='" & Me.txtusername & "' "
Me.lblusername.Visible = False
If rs.NoMatch = True Then
Me.lblusername.Visible = True
Me.txtusername.SetFocus
Exit Sub
End If
Me.lblpassword.Visible = False
If rs!Password <> Me.txtpassword Then
Me.lblpassword.Visible = True
Me.txtpassword.SetFocus
Exit Sub
End If
DoCmd.OpenForm "Dashboard"
DoCmd.Close acForm, Me.Name
End Sub
If txtusername or txtpassword is Null the conditional will fail. Try:
rs.FindFirst "UserName='" & Nz(Me.txtusername,"") & "'"
If rs!Password <> Nz(Me.txtpassword, "") Then
Or consider:
Dim rs As Recordset
With Me
.lblusername.Visible = False
.lblpassword.Visible = False
If IsNull(.txtusername) Or IsNull(.txtpassword) Then
MsgBox "Enter username or password"
Else
Set rs = CurrentDb.OpenRecordset("SELECT UserName, Password FROM [Account Details] " & _
"WHERE UserName='" & .txtusername & "'", dbOpenSnapshot, dbReadOnly)
If Not rs.BOF And Not rs.EOF Then
If rs!Password <> .txtpassword Then
.lblpassword.Visible = True
.txtpassword.SetFocus
Else
DoCmd.OpenForm "Dashboard"
DoCmd.Close acForm, .Name
End If
Else
.lblusername.Visible = True
.txtusername.SetFocus
End If
End If
End With

Show Login name on welcome form

I have made a database in VBA access. I want to display login name on welcome form. Please guide me in this regard. I m trying to pass username from login form to welcome form through public variable but not working. My code is as under:-
Login Form Code
enter code here
Public strUserID As String
Private Sub cmdLogin_Click()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim strSQL As String
If IsNull(Me.txtLoginID) Or Me.txtLoginID = "" Then
MsgBox "Enter user Name.....", vbInformation, "Whiz Alert!"
Me.txtLoginID.SetFocus
Exit Sub
End If
If IsNull(Me.txtPassword) Or Me.txtPassword = "" Then
MsgBox "Enter Password.....", vbInformation, "Whiz Alert!"
Me.txtPassword.SetFocus
Exit Sub
End If
strSQL = "SELECT UserID FROM User WHERE LoginID = """ & Me.txtLoginID.Value & """ AND Password = """ & Me.txtPassword.Value & """"
Set db = CurrentDb
Set rst = db.OpenRecordset(strSQL)
If rst.EOF Then
MsgBox "Incorrect Username/Password.", vbCritical, "Login Error"
Me.txtLoginID.SetFocus
Else
DoCmd.Close acForm, "Index", acSaveYes
DoCmd.OpenForm "HomePage", acNormal, , , , acWindowNormal
DoCmd.Close acForm, "UserLoginForm", acSaveYes
End If
Set db = Nothing
Set rst = Nothing
End Sub
Private Sub txtLoginID_AfterUpdate()
strUserID = Me.txtLoginID
End Sub
Welcome form Code
Private Sub Form_Current()
Me.txtUser = UserLoginForm.strUserID
End Sub
I would move the login operation to a separate function and act according to the return value.
A simple login method which returns True if login was successful, or False if it wasn't. No need to open a recordset here, a simple DCount() will do.
Public Function TryToLogin(ByVal Username As Variant, ByVal Password As Variant) As Boolean
On Error GoTo Trap
'validation
Select Case True
Case IsNull(Username):
MsgBox "Enter user Name.....", vbInformation, "Whiz Alert!"
GoTo Leave
Case IsNull(Password):
MsgBox "Enter Password.....", vbInformation, "Whiz Alert!"
GoTo Leave
End Select
'credentials correct?
If DCount("UserID", "User", "LoginID='" & Username & "' AND Password='" & Password & "'") = 0 Then
MsgBox "Incorrect Username/Password.", vbExclamation, "Login Error"
GoTo Leave
End If
'login successful
TryToLogin = True
Leave:
On Error GoTo 0
Exit Function
Trap:
MsgBox Err.Description, vbCritical
Resume Leave
End Function
The method (I assume a button click event) to call the login function. Check the return value and act based on it. If successful, you can pass the Username using the form's OpenArgs parameter. I presume the welcome form is the homepage?
Private Sub Button_Click()
If Not TryToLogin(txtLoginID.Value, txtPassword.Value) Then Exit Sub
With DoCmd
.Close acForm, "Index", acSaveYes
.OpenForm "HomePage", acNormal, , , , acWindowNormal, txtLoginID.Value
.Close acForm, "UserLoginForm", acSaveYes
End With
End Sub
Lastly, handle the OpenArgs in the welcome form's Load() event.
Private Sub Form_Load()
If Not IsNull(OpenArgs) Then
'the OpenArgs now holds the username.
End If
End Sub

Access 2016 Switchboard convert macro to vba

On an Access 2016 Switchboard I converted the macro behind the form to VBA but it wouldn't compile. A band-aid solution I found was to add .Value to TempVars.Add "CurrentItemNumber", ItemNumber and change both instances of Call Argument & "()" to Call Eval(Argument & "()"). This solved the compile error.
I then added another button "Reports Menu" to the Switchboard but when I click on the new button I get this error.
When I click Debug it highlights this line TempVars.Add "SwitchboardID", Argument. When I added .Value to the end of this line TempVars.Add "SwitchboardID", Argument.Value it solved the breakpoint issue and the new button works but now the Report Menu does not fill in properly.
I can click Return To Main to get back to the Main Menu and all other buttons on the Main Menu work fine except the new Reports Menu Button.
Here is the code behind the switchboard...
Option Compare Database
'------------------------------------------------------------
' Form_Current
'
'------------------------------------------------------------
Private Sub Form_Current()
On Error GoTo Form_Current_Err
'TempVars.Add "CurrentItemNumber", ItemNumber
TempVars.Add "CurrentItemNumber", ItemNumber.Value
Form_Current_Exit:
Exit Sub
Form_Current_Err:
MsgBox Error$
Resume Form_Current_Exit
End Sub
'------------------------------------------------------------
' Form_Open
'
'------------------------------------------------------------
Private Sub Form_Open(Cancel As Integer)
On Error GoTo Form_Open_Err
TempVars.Add "SwitchboardID", DLookup("SwitchboardID", "Switchboard Items", "[ItemNumber] = 0 AND [Argument] = 'Default'")
DoCmd.SetProperty "Label1", acPropertyCaption, DLookup("ItemText", "Switchboard Items", "[SwitchboardID] = " & TempVars("SwitchboardID"))
DoCmd.SetProperty "Label2", acPropertyCaption, DLookup("ItemText", "Switchboard Items", "[SwitchboardID] = " & TempVars("SwitchboardID"))
DoCmd.Requery ""
Form_Open_Exit:
Exit Sub
Form_Open_Err:
MsgBox Error$
Resume Form_Open_Exit
End Sub
'------------------------------------------------------------
' Option1_Click
'
'------------------------------------------------------------
Private Sub Option1_Click()
On Error GoTo Option1_Click_Err
On Error GoTo 0
If (Command = 1) Then
'TempVars.Add "SwitchboardID", Argument
TempVars.Add "SwitchboardID", Argument.Value
DoCmd.SetProperty "Label1", acPropertyCaption, DLookup("ItemText", "Switchboard Items", "[SwitchboardID] = " & TempVars("SwitchboardID"))
DoCmd.SetProperty "Label2", acPropertyCaption, DLookup("ItemText", "Switchboard Items", "[SwitchboardID] = " & TempVars("SwitchboardID"))
DoCmd.Requery ""
Exit Sub
End If
If (Command = 2) Then
DoCmd.OpenForm Argument, acNormal, "", "", acAdd, acNormal
Exit Sub
End If
If (Command = 3) Then
DoCmd.OpenForm Argument, acNormal, "", "", , acNormal
Exit Sub
End If
If (Command = 4) Then
DoCmd.OpenReport Argument, acViewReport, "", "", acNormal
Exit Sub
End If
If (Command = 5) Then
DoCmd.RunCommand acCmdSwitchboardManager
TempVars.Add "SwitchboardID", DLookup("SwitchboardID", "Switchboard Items", "[ItemNumber] = 0 AND [Argument] = 'Default'")
DoCmd.SetProperty "Label1", acPropertyCaption, DLookup("ItemText", "Switchboard Items", "[SwitchboardID] = " & TempVars("SwitchboardID"))
DoCmd.SetProperty "Label2", acPropertyCaption, DLookup("ItemText", "Switchboard Items", "[SwitchboardID] = " & TempVars("SwitchboardID"))
DoCmd.Requery ""
Exit Sub
End If
If (Command = 6) Then
DoCmd.CloseDatabase
Exit Sub
End If
If (Command = 7) Then
DoCmd.RunMacro Argument, , ""
Exit Sub
End If
If (Command = 8) Then
'Call Argument & "()"
Call Eval(Argument & "()")
Exit Sub
End If
Beep
MsgBox "Unknown option.", vbOKOnly, ""
Option1_Click_Exit:
Exit Sub
Option1_Click_Err:
MsgBox Error$
Resume Option1_Click_Exit
End Sub
'------------------------------------------------------------
' OptionLabel1_Click
'
'------------------------------------------------------------
Private Sub OptionLabel1_Click()
On Error GoTo OptionLabel1_Click_Err
On Error GoTo 0
If (Command = 1) Then
'TempVars.Add "SwitchboardID", Argument
TempVars.Add "SwitchboardID", Argument.Value
DoCmd.SetProperty "Label1", acPropertyCaption, DLookup("ItemText", "Switchboard Items", "[SwitchboardID] = " & TempVars("SwitchboardID"))
DoCmd.SetProperty "Label2", acPropertyCaption, DLookup("ItemText", "Switchboard Items", "[SwitchboardID] = " & TempVars("SwitchboardID"))
DoCmd.Requery ""
Exit Sub
End If
If (Command = 2) Then
DoCmd.OpenForm Argument, acNormal, "", "", acAdd, acNormal
Exit Sub
End If
If (Command = 3) Then
DoCmd.OpenForm Argument, acNormal, "", "", , acNormal
Exit Sub
End If
If (Command = 4) Then
DoCmd.OpenReport Argument, acViewReport, "", "", acNormal
Exit Sub
End If
If (Command = 5) Then
DoCmd.RunCommand acCmdSwitchboardManager
TempVars.Add "SwitchboardID", DLookup("SwitchboardID", "Switchboard Items", "[ItemNumber] = 0 AND [Argument] = 'Default'")
DoCmd.SetProperty "Label1", acPropertyCaption, DLookup("ItemText", "Switchboard Items", "[SwitchboardID] = " & TempVars("SwitchboardID"))
DoCmd.SetProperty "Label2", acPropertyCaption, DLookup("ItemText", "Switchboard Items", "[SwitchboardID] = " & TempVars("SwitchboardID"))
DoCmd.Requery ""
Exit Sub
End If
If (Command = 6) Then
DoCmd.CloseDatabase
Exit Sub
End If
If (Command = 7) Then
DoCmd.RunMacro Argument, , ""
Exit Sub
End If
If (Command = 8) Then
'Call Argument & "()"
Call Eval(Argument & "()")
Exit Sub
End If
Beep
MsgBox "Unknown option.", vbOKOnly, ""
OptionLabel1_Click_Exit:
Exit Sub
OptionLabel1_Click_Err:
MsgBox Error$
Resume OptionLabel1_Click_Exit
End Sub
Any suggestions would be appreciated..
Thanks in advance.
In Access 365, there seem to be two errors in the conversion of Switchboard macros to VBA: one in the On Current Event Procedure and one the On Open Event Procedure. The error message points to only to the On Open procedure, while the the On Current event procedure seems to also need to be changed.
On Current: This generates Run Time Error 32538 "TempVars can only store data. They cannot store objects.".
Change TempVars.Add "CurrentItemNumber", ItemNumber to
TempVars.Add "CurrentItemNumber", ItemNumber.Value.
On Open: This generates the compile error.
Change all instances of Call Argument & "()" to Eval (Argument & "()").
Although not necessary, but good coding practice, change all the DoCmd statements that have Argument to Argument.Value.
Hope this is helpful.
Some critique of your code:
Call Eval(Argument & "()") doesn't make any sense. The Call is redundant; Eval(Argument & "()") is what really calls the function name in Argument. Try Application.Run Me.Argument.Value instead.
You should fully specify all control values in your code. Examples: Me.Command.Value, Me.Argument.Value, Me.ItemNumber.Value, etc.
Instead of DoCmd.SetProperty "Label1", acPropertyCaption, "caption", use: Me.Lable1.Caption = "caption"
In every case, there is no need to set Lable2 using the same DLookup function as Label1. Simply use Me.Label2.Caption = Me.Label1.Caption
Instead of TempVars.Add "SwitchboardID", Argument, it is probably cleaner to write TempVars("SwitchboardID") = Me.Argument.Value
This will help you get to your goals, but I can't guarantee this will fix your problems. You will have to use traditional debugging methods to find out what else might be going wrong, and fix it.
I really appreciate the responses but due to time constrains I threw in the towel trying to fix this code that was generated by Access 2016 (when it converted the macros) and grabbed Switchboard from code from an older database that works. I believe that code was created with Access 2003 but it still works perfectly (see below) It has a limit of 8 buttons per switchboard but it should be enough for most applications.
Option Compare Database
Private Sub Form_Open(Cancel As Integer)
' Minimize the database window and initialize the form.
' Move to the switchboard page that is marked as the default.
Me.Filter = "[ItemNumber] = 0 AND [Argument] = 'Default' "
Me.FilterOn = True
End Sub
Private Sub Form_Current()
' Update the caption and fill in the list of options.
Me.Caption = Nz(Me![ItemText], "")
FillOptions
End Sub
Private Sub FillOptions()
' Fill in the options for this switchboard page.
' The number of buttons on the form.
Const conNumButtons = 8
Dim con As Object
Dim RS As Object
Dim stSql As String
Dim intOption As Integer
' Set the focus to the first button on the form,
' and then hide all of the buttons on the form
' but the first. You can't hide the field with the focus.
Me![Option1].SetFocus
For intOption = 2 To conNumButtons
Me("Option" & intOption).Visible = False
Me("OptionLabel" & intOption).Visible = False
Next intOption
' Open the table of Switchboard Items, and find
' the first item for this Switchboard Page.
Set con = Application.CurrentProject.Connection
stSql = "SELECT * FROM [Switchboard Items]"
stSql = stSql & " WHERE [ItemNumber] > 0 AND [SwitchboardID]=" & Me![SwitchboardID]
stSql = stSql & " ORDER BY [ItemNumber];"
Set RS = CreateObject("ADODB.Recordset")
RS.Open stSql, con, 1 ' 1 = adOpenKeyset
' If there are no options for this Switchboard Page,
' display a message. Otherwise, fill the page with the items.
If (RS.EOF) Then
Me![OptionLabel1].Caption = "There are no items for this switchboard page"
Else
While (Not (RS.EOF))
Me("Option" & RS![ItemNumber]).Visible = True
Me("OptionLabel" & RS![ItemNumber]).Visible = True
Me("OptionLabel" & RS![ItemNumber]).Caption = RS![ItemText]
RS.MoveNext
Wend
End If
' Close the recordset and the database.
RS.Close
Set RS = Nothing
Set con = Nothing
End Sub
Private Function HandleButtonClick(intBtn As Integer)
' This function is called when a button is clicked.
' intBtn indicates which button was clicked.
' Constants for the commands that can be executed.
Const conCmdGotoSwitchboard = 1
Const conCmdOpenFormAdd = 2
Const conCmdOpenFormBrowse = 3
Const conCmdOpenReport = 4
Const conCmdCustomizeSwitchboard = 5
Const conCmdExitApplication = 6
Const conCmdRunMacro = 7
Const conCmdRunCode = 8
Const conCmdOpenPage = 9
' An error that is special cased.
Const conErrDoCmdCancelled = 2501
Dim con As Object
Dim RS As Object
Dim stSql As String
On Error GoTo HandleButtonClick_Err
' Find the item in the Switchboard Items table
' that corresponds to the button that was clicked.
Set con = Application.CurrentProject.Connection
Set RS = CreateObject("ADODB.Recordset")
stSql = "SELECT * FROM [Switchboard Items] "
stSql = stSql & "WHERE [SwitchboardID]=" & Me![SwitchboardID] & " AND [ItemNumber]=" & intBtn
RS.Open stSql, con, 1 ' 1 = adOpenKeyset
' If no item matches, report the error and exit the function.
If (RS.EOF) Then
MsgBox "There was an error reading the Switchboard Items table."
RS.Close
Set RS = Nothing
Set con = Nothing
Exit Function
End If
Select Case RS![Command]
' Go to another switchboard.
Case conCmdGotoSwitchboard
Me.Filter = "[ItemNumber] = 0 AND [SwitchboardID]=" & RS![Argument]
' Open a form in Add mode.
Case conCmdOpenFormAdd
DoCmd.OpenForm RS![Argument], , , , acAdd
' Open a form.
Case conCmdOpenFormBrowse
DoCmd.OpenForm RS![Argument]
' Open a report.
Case conCmdOpenReport
DoCmd.OpenReport RS![Argument], acPreview
' Customize the Switchboard.
Case conCmdCustomizeSwitchboard
' Handle the case where the Switchboard Manager
' is not installed (e.g. Minimal Install).
On Error Resume Next
Application.Run "ACWZMAIN.sbm_Entry"
If (Err <> 0) Then MsgBox "Command not available."
On Error GoTo 0
' Update the form.
Me.Filter = "[ItemNumber] = 0 AND [Argument] = 'Default' "
Me.Caption = Nz(Me![ItemText], "")
FillOptions
' Exit the application.
Case conCmdExitApplication
CloseCurrentDatabase
' Run a macro.
Case conCmdRunMacro
DoCmd.RunMacro RS![Argument]
' Run code.
Case conCmdRunCode
Application.Run RS![Argument]
' Open a Data Access Page
Case conCmdOpenPage
DoCmd.OpenDataAccessPage RS![Argument]
' Any other command is unrecognized.
Case Else
MsgBox "Unknown option."
End Select
' Close the recordset and the database.
RS.Close
HandleButtonClick_Exit:
On Error Resume Next
Set RS = Nothing
Set con = Nothing
Exit Function
HandleButtonClick_Err:
' If the action was cancelled by the user for
' some reason, don't display an error message.
' Instead, resume on the next line.
If (Err = conErrDoCmdCancelled) Then
Resume Next
Else
MsgBox "There was an error executing the command.", vbCritical
Resume HandleButtonClick_Exit
End If
End Function
Hope this can help someone else...

Email using a query

Private Sub SendeMail()
Dim rs As Recordset
Dim vRecipientList As String
Dim vMsg As String
Dim vSubject As String
Set rs = CurrentDb.OpenRecordset("SELECT * FROM qryEmailReport ")
If rs.RecordCount > 0 Then
rs.MoveFirst
Do
If Not IsNull(rs! tbl.ContractorEmailaddress ) Then
vRecipientList = vRecipientList & rs! FieldThatHoldsTheeMailAddresses & ";"
rs.MoveNext
Else
rs.MoveNext
End If
Loop Until rs.EOF
vMsg = " Your Message here... "
vSubject = " Your Subject here... "
DoCmd.SendObject acSendReport, " rptProposal ", acFormatPDF, vRecipientList, , , vSubject, vMsg, False
MsgBox ("Report successfully eMailed!")
Else
MsgBox "No contacts."
End If
End Sub
I am looking to create a VBA string for a DoCmd.
I have a query that filters Report ID and the Contractors Email. I need a on click code made that will take the ReportID off of the form and then send it to all of the Email addresses that are linked to that ReportID. I was going to use a DoCmd.SendObject, but I'm not sure about how to write it.
Here's the relevant MSDN section:
https://msdn.microsoft.com/en-us/library/office/ff197046.aspx
Basic usage:
Docmd.SendObject acSendQuery, MyQueryName, acFormatXLS _
"To Email", "CC Email", ,"My Subject Line"