The below code keeps looping, and I don't know how to exit the loop.
Private Sub Extension_AfterUpdate()
Dim AnswerYes As String
Dim AnswerNo As String
If [Extension] = "Yes" Then
AnswerYes = MsgBox("Do you wish to create a new case for this customer?", vbQuestion + vbYesNo, "User Response")
If AnswerYes = vbYes Then
DoCmd.OpenForm "ManagersLogF", acNormal, "", "", , acNormal
DoCmd.GoToRecord acForm, "ManagersLogF", acNewRec
Else
[Extension] = "No"
End If
Else
End If
End Sub
With the above the msgbox doesn't keep prompting but with the one below yes.
Private Sub Extension_AfterUpdate()
Dim AnswerYes As String
Dim AnswerNo As String
If [Extension] = "Yes" Then
AnswerYes = MsgBox("Do you wish to create a new case for this customer?", vbQuestion + vbYesNo, "User Response")
If AnswerYes = vbYes Then
DoCmd.RunCommand acCmdSelectRecord
DoCmd.RunCommand acCmdCopy
DoCmd.OpenForm "ManagersLogF", acNormal, "", "", , acNormal
DoCmd.GoToRecord acForm, "ManagersLogF", acNewRec
DoCmd.RunCommand acCmdPaste
Else
[Extension] = "No"
End If
Else
End If
End Sub
thanks for your help.
You don't save the record, so it will not read the "No". So:
Private Sub Extension_AfterUpdate()
Dim Answer As VbMsgBoxResult
If Me![Extension].Value = "Yes" Then
Answer = MsgBox("Do you wish to create a new case for this customer?", vbQuestion + vbYesNo, "User Response")
If Answer = vbYes Then
DoCmd.OpenForm "ManagersLogF", acNormal, "", "", , acNormal
DoCmd.GoToRecord acForm, "ManagersLogF", acNewRec
Else
Me![Extension]Value = "No"
' Save record.
Me.Dirty = False
End If
Else
End If
End Sub
Related
Okay. Let me try to explain what is happening here.
User will select record in form 1 and click button.
That will open form 2 to a detail form of that record.
User will then select one or multiple codes from Form 2 and click order button.
Form 3 will open with the info from Form 2, but I am having trouble getting the codes to fill in on Form 3. This is where I need help.
Existing code as follows:
**Form 1 CODE**
Option Compare Database
Option Explicit
Private Sub RequeryForm()
Dim SQL As String, WhereStr As String
WhereStr = ""
If Search <> "" Then
If WhereStr <> "" Then WhereStr = WhereStr & " AND "
WhereStr = "LocationID Like ""*" & AccountSearch & "*"""
End If
If NameSearch <> "" Then
If WhereStr <> "" Then WhereStr = WhereStr & " AND "
WhereStr = "FirstNameLastName Like ""*" & NameSearch & "*"""
End If
If CodeSearch <> "" Then
If WhereStr <> "" Then WhereStr = WhereStr & " AND "
WhereStr = "Code Like ""*" & CodeSearch & "*"""
End If
SQL = "Select * From AMSQuery"
If WhereStr <> "" Then
SQL = SQL & " Where " & WhereStr
End If
Me.RecordSource = SQL
End Sub
Private Sub ClearSearchBtn_Click()
SetDefaults
RequeryForm
End Sub
Private Sub OpenDetailbtn_Click()
DoCmd.OpenForm "Form2", , , "LocationID=" & Me.LocationID
End Sub
Private Sub SearchBtn_Click()
RequeryForm
End Sub
Private Sub SetDefaults()
AccountSearch = Null
NameSearch = Null
CodeSearch = Null
End Sub
**Code For Form2**
Private Sub ExitBTN_Click()
DoCmd.Close acForm, "Form2"
End Sub
Private Sub OrderILbtn_Click()
DoCmd.OpenForm "RequestForm", acNormal, , , acFormAdd
End Sub
**Form 3 Code**
Option Compare Database
Option Explicit
'Private Sub IncNumber_BeforeUpdate(Cancel As Integer)
'If Not (Me!IncNumber = "IncNumber" Or (Me!IncNumber <> 11) Or IsNull(Me!IncNumber)) Then
'MsgBox "The Incident Number entered is less than 11 characters."
'Cancel = True
'End If
'End Sub
Private Sub CloseFormBtn_Click()
DoCmd.Close acForm, "Form3", acSaveYes
DoCmd.SelectObject acForm, "Form1"
End Sub
Private Sub Form_Load()
Forms!RequestForm!Account = Forms!Form2!LocationID
End Sub
Private Sub SaveBtn_Click()
If IsNull([Account]) Then
MsgBox "You forgot to add a Y account.", vbOKOnly, "Missing Y account Warning!"
Else
DoCmd.RunCommand acCmdSaveRecord
DoCmd.GoToRecord , , acNewRec
End If
'ILRequestID = "IL" & Right(Year([DateAndTimeRequested]), 2) & Format(Month([DateAndTimeRequested]), "00") & Format(Day([DateAndTimeRequested]), "00") & [EntryID]
End Sub
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
I have a VBA macro code to SAVE AS an Excel Invoice using a button. Whenever I click "YES", the file is saved again. But when I click "NO", "CANCEL" or even CLOSE the MSgBox window, I Get Run-time error '1004', Cannot access 'filename.xlsm'.
Sub Save_As()
Dim filename As String
Dim msgResponse As VbMsgBoxResult
filename = "C:\Users\bala\Desktop\SDH\Excel Invoice\" & Range("F4") & Range("G4") & "_" & Range("M10")
If Len(Dir(filename)) = 0 Then
ActiveSheet.SaveAs filename, FileFormat:=52, CreateBackup:=True
Application.DisplayAlerts = True
MsgBox "Invoice saved successully", vbOKOnly, "INVOICE SAVED"
Else
msgResponse = MsgBox("Do you want to overwrite?", vbYesNoCancel)
If msgResponse = vbYes Then
ActiveSheet.SaveAs filename, FileFormat:=52, CreateBackup:=True
Application.DisplayAlerts = True
MsgBox "Invoice saved successully", vbOKOnly, "INVOICE SAVED"
Else
Exit Sub
End If
End If
End Sub
You should always check the response to user input, in this case what button was pressed.
Dim msgResponse As VbMsgBoxResult
msgResponse = MsgBox("Do you want to overwrite?", vbYesNoCancel)
If msgResponse = vbYes Then
' Overwrite file
Else
' Don't
End If
I am using the following vba code in my form.
Private Sub imgCustomer_Click()
On Error GoTo Err_Handler
DoCmd.Close acForm, "frmCustomer", acSaveYes
DoCmd.OpenForm "frmSplashScreen"
Exit_This_Sub:
Exit Sub
Err_Handler:
MsgBox "Error #: " & Err.Number & " " & Err.Description
Resume Exit_This_Sub
End Sub
My problem is that the form contains textbox which must not left empty. If for example Surname and Name fields must have a value and the user only fill the Surname and press the imgCustomer_Click, the database will continue without showing a error to fill up the empty fields. Any ideas?
ps: Can I use a vba so it will automatically fill the field with a value, instead?
You can write a function to validate the required fields and proceed when validation is successful.
Private Function FormValidated() As Boolean
With Me
If IsNull(.FirstControlName.Value) Then Exit Function
If IsNull(.SecondControlName.Value) Then Exit Function
'additional controls...
End With
FormValidated = True
End Function
You can then call it in your procedure:
Private Sub imgCustomer_Click()
On Error GoTo Err_Handler
If Not FormValidated Then
MsgBox "Validation failed.", vbExclamation
GoTo Exit_This_Sub
End If
DoCmd.Close acForm, "frmCustomer", acSaveYes
DoCmd.OpenForm "frmSplashScreen"
Exit_This_Sub:
Exit Sub
Err_Handler:
MsgBox "Error #: " & Err.Number & " " & Err.Description
Resume Exit_This_Sub
End Sub
Edit:
If this is a bound form, you need to cancel the auto-update and save the record only when validation is successful.
Option Explicit
'Set a flag for manual update
Private mIsUserUpdate As Boolean 'Flag
'Cancel auto-update
Private Sub Form_BeforeUpdate(Cancel As Integer)
If Not mIsUserUpdate Then Cancel = True
End Sub
'Save
Private Sub imgCustomer_Click()
On Error GoTo Err_Handler
If Not FormValidated Then
MsgBox "Validation failed.", vbExclamation
GoTo Exit_This_Sub
End If
mIsUserUpdate = True 'flag ON
DoCmd.RunCommand acCmdSaveRecord
DoCmd.Close acForm, "frmCustomer", acSaveYes
DoCmd.OpenForm "frmSplashScreen"
Exit_This_Sub:
mIsUserUpdate = False 'Flag OFF
Exit Sub
Err_Handler:
MsgBox "Error #: " & Err.Number & " " & Err.Description
Resume Exit_This_Sub
End Sub
'Validation
Private Function FormValidated() As Boolean
With Me
If IsNull(.FirstControlName.Value) Then Exit Function
If IsNull(.SecondControlName.Value) Then Exit Function
'additional controls...
End With
FormValidated = True
End Function
The OpenForm has reoccurred in my application. I have decompiled/compact and repaired twice.
Code throwing error:
'Open Menu form
DoCmd.OpenForm "Menu", acNormal, , , , acWindowNormal
The first time I encountered this error, I solved it by changing:
DoCmd.OpenForm "Menu", acNormal, "", "", , acNormal
to
DoCmd.OpenForm "Menu", acNormal, , , , acWindowNormal.
This is my procedure that suffers the exception:
Private Sub Login(recordSet As DAO.recordSet, PERSAL As String, Password As String)
On Error GoTo Login_ErrHandler
'Check to see if the recordset actually contains rows
If Not (recordSet.EOF And recordSet.BOF) Then
recordSet.MoveFirst 'Unnecessary in this case, but still a good habit
'See if credentials match data
Do
If (recordSet!User_ID = PERSAL And recordSet!Password = Password) Then
'Open Menu form
DoCmd.OpenForm "Menu"
' Form_Menu.op
recordSet.Close 'Close the recordset
Set recordSet = Nothing 'Clean up
'Close Login form
DoCmd.Close acForm, "Login"
Exit Do
End If
recordSet.MoveNext
If (recordSet.EOF Or recordSet.BOF) Then
MsgBox "Your credentials are incorrect or you are not registered."
Exit Do
End If
Loop
'Match the values entered for PERSAL nr. and password fields with a row in User table
Else
MsgBox "There are no records in the recordset."
recordSet.Close 'Close the recordset
Set recordSet = Nothing 'Clean up
End If
Form_Login.txtUser_ID.SetFocus
Login_ErrHandler:
If Err = 2501 Then
'MsgBox "No data to display"
DoCmd.Hourglass False
Resume Login_ErrHandler
' Else
' MsgBox Err.Description, vbCritical
End If
End Sub
How do I fix this error this time around?
Create a parameterized query with the following SQL:
PARAMETERS [prmUserId] Text ( 255 ), [prmPassword] Text ( 255 );
SELECT User_ID, Password
FROM YOUR_TABLE_NAME
WHERE ((([User_ID])=[prmUserId]) AND (([Password])=[prmPassword]));
Assuming the code is behind the Login Form:
Private Sub Login(ByVal PERSAL As String, ByVal Password As String)
On Error GoTo Login_ErrHandler
Dim qdf As DAO.QueryDef
Set qdf = CurrentDb().QueryDefs("YourQueryName") 'Change to your query name
qdf.Parameters("[prmUserId]").Value = PERSAL
qdf.Parameters("[prmPassword]").Value = Password
Dim rs As DAO.recordSet
Set rs = qdf.OpenRecordset()
'No records
If rs.EOF Then
MsgBox "Your credentials are incorrect or you are not registered."
Me.txtUser_ID.SetFocus
GoTo Leave
End If
'User found
'Close Login Form
DoCmd.Close acForm, Me.Name, acSavePrompt
'Open Form
DoCmd.OpenForm "Menu", acNormal, , , acFormPropertySettings, acWindowNormal
Leave:
On Error Resume Next
rs.Close
Set rs = Nothing
qdf.Close
Set qdf = Nothing
On Error GoTo 0
Exit Sub
Login_ErrHandler:
MsgBox Err.Number & " - " & Err.Description, vbCritical
Resume Leave
End Sub