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...
Related
I have a form that if a duplicate record is entered, the form creates an error message and prevents the record from being entered. However, my code is popping up the error message no matter what I'm putting in. My code is this...
Private Sub cmdSave_Click()
' ToDo fix the labels in this function so they match the function name. Just cosmetic.
On Error GoTo Add_CmdSave_Click_Err
On Error Resume Next
' ToDo fix the labels in this function so they match the function name. Just cosmetic.
On Error GoTo Add_CmdSave_Click_Err
On Error Resume Next
Me.cbCompletedTrainingID = Me.IntermediateID
'
Dim OKToSave As Boolean
OKToSave = True
If Not SomethingIn(Me.[fIntermediate FacultyID]) Then ' Null
Beep
MsgBox "A faculty member is required", vbOKOnly, "Missing Information"
OKToSave = False
End If
If Not SomethingIn(Me.[fIntermediate TrainingID]) Then
Beep
MsgBox "A training is required", vbOKOnly, "Missing Information"
OKToSave = False
Else
Dim rs As Object
Set rs = Me.Recordset.Clone
rs.FindFirst "[IntermediateID] = " & Me.[fIntermediate FacultyID] And Me.[fIntermediate TrainingID]
If Not rs.EOF Then
Beep
MsgBox "This person has already completed this training", vbOKOnly, "Duplicate Training Completion"
OKToSave = False
End If
End If
If OKToSave Then
' If we get this far, all data is valid and it's time to save
Me.Dirty = False
DoCmd.GoToRecord , "", acNewRec
End If
Add_CmdSave_Click_Exit:
Exit Sub
Add_CmdSave_Click_Err:
Resume Add_CmdSave_Click_Exit
End Sub
The issue, from my standpoint, lies in this part...
Dim rs As Object
Set rs = Me.Recordset.Clone
rs.FindFirst "[IntermediateID] = " & Me.[fIntermediate FacultyID] And Me.[fIntermediate TrainingID]
If Not rs.EOF Then
Beep
MsgBox "This person has already completed this training", vbOKOnly, "Duplicate Training Completion"
OKToSave = False
End If
What am I doing wrong?
Have a look at How to debug dynamic SQL in VBA.
This line makes no sense as it is:
rs.FindFirst "[IntermediateID] = " & Me.[fIntermediate FacultyID] And Me.[fIntermediate TrainingID]
You probably want something like
S = "[IntermediateID] = " & Me.[fIntermediate FacultyID] & " And [TrainingID] = " & Me.[fIntermediate TrainingID]
Debug.Print S ' Ctrl+G shows the output
rs.FindFirst S
Also, remove all these On Error Resume Next - this will happily ignore any errors, making debugging nearly impossible.
Also useful: Debugging VBA Code
And there is more: If Recordset.FindFirst doesn't find a match, it doesn't trigger .EOF. It sets the .NoMatch property.
rs.FindFirst S
If rs.NoMatch Then
' all is good, proceed to save
Else
' record exists
End If
This should work as intended:
Dim rs As DAO.Recordset
Dim Criteria As String
Set rs = Me.RecordsetClone
Criteria = "[IntermediateID] = " & Me![fIntermediate FacultyID].Value & " And [TrainingID] = " & Me![fIntermediate TrainingID].Value & ""
Debug.Print OKToSave, Criteria
rs.FindFirst Criteria
If Not rs.NoMatch Then
Beep
MsgBox "This person has already completed this training", vbInformation + vbOKOnly, "Duplicate Training Completion"
OKToSave = False
End If
rs.Close
Debug.Print OKToSave
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
I'm using vba in an MS Access form to insert data from Access into MS Word content controls. The code works for text fields, date fields and checkbox fields. But I'm having trouble inserting data into the drop-down field. My drop-down list properties in MS Word uses a "display name" and value to store the data (e.g. Display Name=Adirondack and Value=1, Display Name=Buffalo and Value=2). Here is the code that works along with the error message that results from attempting to insert into a drop-down list. Your help will be much appreciated!
Private Sub Command179_Click()
' subroutine for exporting referral data from MS Access table to MS Word form content controls
Dim CC As ContentControl
Dim objLE As ContentControlListEntry
Dim fc As Field
Dim ccInfo As String
Dim Female As String
Dim appWord As Word.Application
Dim doc As Word.Document
Dim strDocName As String
Dim blnQuitWord As Boolean
On Error GoTo ErrorHandling
strPath = "C:\Users\AlbanyHiker\Documents\Custom Office Templates\INTAKE FORM\INTAKE BLANK FORM.docm"
strDocName = strPath
Set appWord = GetObject(, "Word.Application")
appWord.Visible = True
Set doc = appWord.Documents.Open(strDocName)
If IsNull(Me!ref_referral_dt) Then
MsgBox "REFERRAL DATE IS MISSING, COMPLETE FORM BEFORE EXPORT"
Me!ref_referral_dt = #1/1/9999#
End If
For Each CC In doc.ContentControls
ccInfo = "<> ID= " & CC.ID & " Title = " & CC.Title & " tag = " & CC.Tag & " Text = " & CC.Range.Text & vbCrLf
Debug.Print ccInfo
Select Case CC.Tag:
Case "frm_referral_dt"
CC.Range.Text = Me!ref_referral_dt
Case "frm_referral_number"
CC.Range.Text = Me!ref_referral_number
Case "frm_part_name_first"
CC.Range.Text = Me!ref_part_name_first
Case "frm_part_name_last"
CC.Range.Text = Me!ref_part_name_last
Case "frm_part_address1"
CC.Range.Text = Me!ref_part_address1
Case "frm_part_address2"
CC.Range.Text = Me!ref_part_address2
Case "frm_mailing_current"
If Me!ref_mailing_current = "-1" Then CC.Checked = True
Case "frm_part_city"
CC.Range.Text = Me!ref_part_city
Case "frm_part_zip"
CC.Range.Text = Me!ref_part_zip
Case "frm_part_telephone"
CC.Range.Text = Me!ref_part_telephone
' Next case statement throws the following error message
' 6124: you are not allowed to edit this selection because it is protected
Case "frm_part_region"
CC.Range.Text = Me!ref_part_region
End Select
Next
MsgBox "INTAKE Report Data Was Successfully Exported, Remember to Save the Word-Fillable File Using a Different Name"
Cleanup:
'do something here to cleanup stuff
Exit Sub
ErrorHandling:
Select Case Err.Number
Case -2147022986, 429
Set appWord = CreateObject("Word.Application")
blnQuitWord = True
Resume Next
Case -2147352571
MsgBox "There is a Type Mismatch Error indicating that a date may have been mistyped" _
& " No data imported. PLEASE CHECK DATA ENTRY ON ALL DATES ", vbOKOnly, _
" Please check the date entries on the form"
Case 5121, 5174
MsgBox "You must select a valid Word Document. " _
& " No data was imported.", vbOKOnly, _
" Document Not Found"
Case 5491
MsgBox "The document you selected does not" _
& " contain the required form fields." _
& " No data exported.", vbOKOnly, _
" Fields Not Found"
Case Else
MsgBox Err & ": " & Err.Description
End Select
GoTo Cleanup
ExitSubError:
Set rs = Nothing
'..and set it to nothing
MsgBox "Export failed, correct problems and export again"
Exit Sub
End Sub
I have taken a macro that was embedded and converted it into vba so I can call it on different forms when needed. The form I am using is an employee list form and I am using it on the first name. I have tried calling the function by putting =MyFunction() and I get the object is closed or doesn't exist.
It works as an embedded macro; however, when I try to use it as a standalone I get an error and when I converted it I get the above error.
Function Copy_Of_CompID_Fields()
On Error GoTo Copy_Of_CompID_Fields_Err
With CodeContextObject
On Error Resume Next
If (Eval("[Forms].[Dirty]")) Then
DoCmd.RunCommand acCmdSaveRecord
End If
If (.MacroError.Number <> 0) Then
Beep
MsgBox .MacroError.Description, vbOKOnly, ""
Exit Function
End If
On Error GoTo 0
If (IsNull(.New_Id)) Then
Exit Function
End If
If (.CreatedDate < #5/1/2019#) Then
DoCmd.OpenForm "Employee Details", acNormal, "", "[ID]='" & .ID & "'", , acNormal
Else
DoCmd.OpenForm "Employee Details", acNormal, "", "[New_Id]=" & .ID, , acNormal
End If
TempVars.Add "CurrentID", .ID
DoCmd.Requery ""
DoCmd.SearchForRecord , "", acFirst, "[ID]='" & TempVars!CurrentID & "'"
TempVars.Remove "CurrentID"
End With
Copy_Of_CompID_Fields_Exit:
Exit Function
Copy_Of_CompID_Fields_Err:
MsgBox Error$
Resume Copy_Of_CompID_Fields_Exit
End Function
In a form, create a new record, edit some data but before saving it use a combo box on the form to select another record to navigate to. This triggers the cboSalePicker_AfterUpdate. Then during this sub Form_BeforeUpdate executes. The user clicks no on the MsgBox to not save the new record. Then the rest of cboSalePicker_AfterUpdate is executed however the following error message is displayed:
Error Message
Error number -2147417848: Method ‘FindFirst’ of object ‘Recordset2’ failed.
Associated with the line Me.Recordset.FindFirst "[SaleID] = " & Str(Nz(cboSalePicker.Value, 0))
However, if the new record is saved no error is produced and the code performs as expected.
Form_BeforeUpdate
Private Sub Form_BeforeUpdate(Cancel As Integer)
On Error GoTo ErrorHandler
Dim strMsg As String
Dim iResponse As Integer
'Specify the mesage to display
strMsg = "Do you wish to save the changes?" & Chr(10)
strMsg = strMsg & "Click Yes to Save or No to Discard changes."
'Display the msg box
iResponse = MsgBox(strMsg, vbQuestion + vbYesNo, "Save Record?")
'Check response
If iResponse = vbNo Then
'Undo the change.
DoCmd.RunCommand acCmdUndo
'Cancel the update
Cancel = True
End If
Exit Sub
ErrorHandler:
MsgBox "Error number " & Err.Number & ": " & Err.Description
End Sub
cboSalePicker_AfterUpdate
Private Sub cboSalePicker_AfterUpdate()
On Error GoTo ErrorHandler
Me.Recordset.FindFirst "[SaleID] = " & Str(Nz(cboSalePicker.Value, 0))
Exit Sub
ErrorHandler:
MsgBox "Error number " & Err.Number & ": " & Err.Description
End Sub
Thanks
You are converting Your SaleID into a String using this
Str(Nz(cboSalePicker.Value, 0))
But your find first is looking for a number. If SaleID is a number then remove the Str() function from your code around the combobox value.
To show the concatenation try this
Private Sub cboSalePicker_AfterUpdate()
On Error GoTo ErrorHandler
Dim sCriteria as String
sCriteria = "[SaleID] = " & Nz(Me.cboSalePicker, 0)
debug.print sCriteria
Me.Recordset.FindFirst sCriteria
Exit Sub
ErrorHandler:
MsgBox "Error number " & Err.Number & ": " & Err.Description
End Sub
Comment out the first error handler line whilst you are debugging things.