I am running into a 2467 error after the following code ():
Option Compare Database
Option Explicit
Private Sub CmdReject_Click()
Dim lngID As Long
lngID = Me.ID
If Me.Dirty Then Me.Dirty = False
DoCmd.Close , ""
Beep
MsgBox "Issue has been saved.", vbInformation, ""
NewFormIssue (lngID)
End Sub
Private Sub NewFormIssue(lngID As Long)
DoCmd.OpenForm "Frm_Issue_Entry", acNormal, , , acFormAdd
Me.Person.Value = DLookup("[Previous_Person]","[tbl_Issue_Log]", "[ID] = " lngID)
End Sub
The run-time error occurs during the Me.Person.Value = DLookup("[Person]","[tbl_Issue_Log]", "[ID] = " lngID) line.
I am trying to use the ID of the previous form to populate 11 fields on this new form so the user doesn't have to redo everything using dlookup, which worked before but I can't seem to find why it just stopped working...
I think I figured out what was happening (at least from a high level standpoint). The Me was still pointing to the previously closed form, not the new form added, causing the error. I fixed the issue by using Form_Frm_Issue_Entry.Person.Value instead, but I am not sure why it worked previously.
Related
I am trying to write a code that will print out my current form for the current record. This is what I am using:
Private Sub PrintCommand_Click()
Dim myform As Form
Dim pageno As Long
pageno = Me.CurrentRecord
Set myform = Screen.ActiveForm
DoCmd.SelectObject acForm, myform.Name, True
DoCmd.PrintOut acPages, pageno, pageno, , 1
DoCmd.SelectObject acForm, myform.Name, False
End Sub
When I dimension "pageno" as an integer, it gives me an overflow error for some of my records that exceed 65000. So, I dimensioned it as a long data type, but then I receive the following error:
Run-time error '2498': An expression you entered is the wrong data type for one of the arguments."
I also tried making "pageno" a variant data type, and I received the same 2498 error message. Any suggestions on either a way to fix this or another work around for printing my form for the current record?
Update: This works and accomplishes what I was going for...
Private Sub PrintCommand_Click()
'Print out the current record
Me.Filter = "[Quote Number] = " & QuoteNumberEntry.Value
Me.FilterOn = True
DoCmd.PrintOut
Me.Filter = ""
Me.FilterOn = False
End Sub
Executing Append Query not doing anything
I'm having an odd problem that just reared its ugly head for some reason. I have a form that is used to add/edit/delete records in tblWorkOrder. When the record is saved, a check is made to see if the companion record in tblServiceRecord exists, and if not (like if it were the first time the record in tblWorkOrder is being saved/input) it will execute a query (qryCreateSR).
Several weeks ago it worked just fine. I had no problems with it, but then I updated tblServiceRecord to add several new columns and now it's not working at all. However, the SQL for the query doesn't delineate any of these new columns, let alone any specific information from tblWorkOrder. So I'm not entirely sure how this bug came up.
Here is the SQL:
INSERT INTO tblServiceRecord ( WorkOrderID )
SELECT Forms![frmWorkOrders].Form![txtID];
And here is the code behind the command button:
Private Sub cmdSave_Click()
If DCount("*", "[tblServiceRecord]", "[WorkOrderID] = " & [Forms]![frmWorkOrders].[Form]![txtID]) > 0 Then
Else
DoCmd.SetWarnings False
DoCmd.OpenQuery "qryCreateSR"
End If
DoCmd.RunCommand acCmdSaveRecord
DoCmd.GoToRecord , "", acNewRec
Me.lstWorkOrders.Requery
Me.lstWorkOrders.Value = ""
Me.txtComments.Value = ""
cmdSave_Click_Exit:
Exit Sub
cmdSave_Click_Err:
MsgBox Error$
Resume cmdSave_Click_Exit
End Sub
After removing the warnings suppression I get a key violation issue.
No clue what is causing the key violations. I checked my tables, and the two tables in question are tblWorkOrder and tblServiceRecord. Both have no records in them, I compacted the database, the linked fields (in tblServiceRecord, there is a reference to tblWorkOrder with the field WorkOrderID) are set to the same data type (number), and the child-tables are set to Indexed (No).
Just in case anyone wants to look at the database itself, here is a link:
https://drive.google.com/open?id=1_T-G9fyYQYjH3-YBe4PXhbBDTKNmY3ce
Try saving the current record in the form (by setting Me.Dirty = False), before inserting the record to the other table. Since you try to insert into a child table with a relation to a parent table, you must have a corresponding (saved) record in the parent table. When you create a new entry in the form, it first doesn't exist in the table until it is saved for the first time.
Private Sub cmdSave_Click()
Me.Dirty = False ' Or DoCmd.RunCommand acCmdSaveRecord <==== Save here
If DCount("*", "[tblServiceRecord]", "[WorkOrderID] = " & [Forms]![frmWorkOrders].[Form]![txtID]) = 0 Then
DoCmd.SetWarnings False
DoCmd.OpenQuery "qryCreateSR"
End If
'Removed: DoCmd.RunCommand acCmdSaveRecord <==== instead of here
DoCmd.GoToRecord , "", acNewRec
Me.lstWorkOrders.Requery
Me.lstWorkOrders.Value = ""
Me.txtComments.Value = ""
cmdSave_Click_Exit:
DoCmd.SetWarnings True
Exit Sub
cmdSave_Click_Err: // This code will never run, since a "On Error Goto cmdSave_Click_Err" is missing
MsgBox Error$
Resume cmdSave_Click_Exit
End Sub
For various reasons, I want to set up a custom button on my forms to save the current record. I use a navigation form and want to trigger the same process (integrity-checks, user input etc.) whenever the entry is saved, thus whenever the user presses the "save"-button or switches to another form. The user will conditionally be asked to confirm the process and is thus able to cancel it as well.
Everything is running smoothly with one really odd and annoying exception: Whenever I click the save button on a new record and prompt a message within the "BeforeUpdate" event, I receive
RTE 3021 ("no current record")
Without the MsgBox, everything is fine. Even more strange:
When I trigger the save process by switching to another form using the navigation form (or simply press "outside" the form used for data entry), everything is fine as well.
Here is a minimalistic example (similar results with DoCmd.Save, Requery or acCmdSaveRecord):
Private Sub vt_save_Click()
Me.Dirty = False
End Sub
Private Form_BeforeUpdate(Cancel As Integer)
Cancel = True
MsgBox "Test"
End Sub
Any ideas? I simply can't wrap my head around that error.
You could maybe try to run a query using the values in the form while checking if the record exists or not.
Is there a primary key on the table? if so, the primary key will be your focal point.
Private Sub vt_Save_Click()
dim rst as DAO>Recordset
Dim strSQL as String
Dim strID as string
strID = me.YourPrimaryKeyField
strSQL = "SELECT * " & _
"FROM YourTableName " & _
"WHERE (((YourTableName.YourFieldName) =" & me.PrimaryKeyField & "));"
set rst = currentdb.openrecordset(strsql)
if rst.recordcount = 0 then
currentdb.execute "INSERT INTO YourTableName ( List All Fields to Add ) " & _
"SELECT List All Field controls with values to add;"
End IF
'Anything else you want the code to do from here
EndCode:
If not rst is nothing then
rst.close
set rst = nothing
End IF
End Sub
Repeat this process for the Form_LostFocus() event. If you want to make it easier, make this code a module and call within both event triggers on your form.
If this doesn't work please let me know and I will be happy to further assist.
The most straight forward and reasonable solution is to use an Error Handler - which I ignored so far tenaciously.
Private Sub save_Click()
On Error GoTo Err_Handler
Me.Dirty = False
Exit_Here:
Exit Sub
Err_Handler:
If Err.Number = 2101 Then
'ignore or message
Else
MsgBox Err.Description
End If
Resume Exit_Here
End Sub
I am sending data from frmSearchEmployeeWorksheets to frmStatsCorr which runs a query (qryStatsCorr). On frmStatsCorr I am checking to make sure the query returns records otherwise I will Msg the user and return to the search form. My problem is that I am having problems 'ignoring' the 2501 caused by the DoCmd.OpenForm ("frmStatsCorr") which I learned here on Stackoverflow...
What am I doing wrong that is causing me major Access VBA Frustration??
This is the sub on the Search form (frmSearchEmployeeWorksheets):
Private Sub btnSearch_Click()
' I only change focus to force the updated data to submit to query
Me.[txtEmployee].SetFocus
Me.txtShift.SetFocus
If txtUnit = "7" Then
'First close the form in order to update
DoCmd.Close acForm, "frmStatsCorr"
' Open Stats form
On Error GoTo myErr
**DoCmd.OpenForm ("frmStatsCorr") 'causes error**
End If
myExit:
Exit Sub
myErr:
Echo True
If Err.Number = 2501 Then GoTo myExit
MsgBox Err.Description
GoTo myExit
End Sub
In frmStatsCorr I simply check to make sure the query returns records if not I inform the user, close the form, and return to the frmSearchEmployeeWorksheets
Private Sub Form_Load()
If strFormStatus = "view" Then
If DCount("*", "qryStatsCorr") = 0 Then
MsgBox "Your search does not produce any results. Try a different search.", vbOKOnly
DoCmd.Close
DoCmd.OpenForm ("frmSearchEmployeeWorksheets")
Exit Sub
End If
txtDay = WeekdayName(Weekday(Me.WorkDate)) 'This line returns an error so I check for an empty query and return to the search form.
Me.[WorkDate].SetFocus
Me.txtUnit.Enabled = False...
I'm unsure how well I understand your code or the logic behind it. My hunch is you should check the DCount result from btnSearch_Click, and not fiddle with closing then re-opening frmStatsCorr, and having frmStatsCorr close itself when it contains no data. Just do not open frmStatsCorr when it will not contain data.
If the current form (frmSearchEmployeeWorksheets) which holds your btnSearch_Click procedure contains unsaved data changes, you can save them with Me.Dirty = False
Private Sub btnSearch_Click()
Dim strPrompt As String
If Me.Dirty Then ' unsaved data changes
Me.Dirty = False ' save them
End If
If Me.txtUnit = "7" Then
If DCount("*", "qryStatsCorr") = 0 Then
strPrompt = "Your search does not produce any results. " & _
"Try a different search."
MsgBox strPrompt, vbOKOnly
Else
' if frmStatsCorr is open, just Requery
' else open frmStatsCorr
If CurrentProject.AllForms("frmStatsCorr").IsLoaded Then
Forms("frmStatsCorr").Requery
Else
DoCmd.OpenForm "frmStatsCorr"
End If
' uncomment next line to close current form
'DoCmd.Close acForm, Me.Name
End If
End If
End Sub
If frmStatsCorr is open and you need to check whether it is in Design View, examine its CurrentView property.
Forms("frmStatsCorr").CurrentView ' Design View = 0
I suggested that approach because I suspected frmStatsCorr's Form_Load may trigger the 2501 error when it closes itself. But I'm not certain that's the cause of the error and I'm not motivated enough to set up a test.
If you still have 2501 errors with the approach I suggested, there are two other possible causes I've encountered:
corruption
broken references
I try to improve a report I made to document databases, by adding a VBA line count to Modules and Forms. The following code works perfectly in a standard module:
Sub test()
Dim accObj As AccessObject, bwasOpen As Boolean, objName As String
objName = "Form1"
Set accObj = CurrentProject.AllForms(objName)
bwasOpen = accObj.IsLoaded
If Not bwasOpen Then
DoCmd.OpenForm objName, acDesign, WindowMode:=acHidden
End If
If Forms(objName).HasModule Then
DoCmd.OpenModule "Form_" & objName
Debug.Print Modules("Form_" & objName).CountOfLines
End If
If Not bwasOpen Then
DoCmd.Close acForm, objName, acSaveNo
End If
End Sub
But when I use a similar code in the report itself, I have an error. And since that error is happening in the class module (the report), I feel a bit stuck with debugging. The code in the report:
Set accObj = CurrentProject.AllForms(objName)
bwasOpen = accObj.IsLoaded
If Not bwasOpen Then
DoCmd.OpenForm objName, acDesign, WindowMode:=acHidden 'Breaks here
End If
If Forms(objName).HasModule Then
DoCmd.OpenModule "Form_" & objName
GetExtraInfo = Modules("Form_" & objName).CountOfLines
End If
If Not bwasOpen Then
DoCmd.Close acForm, objName, acSaveNo
End If
The code is called from a report control using =GetExtraInfo(). The whole thing works well, except this new part where I want to return the CountOfLines for Forms.
Update: I have added some error trapping, and it gives error:
2486 - You can't carry out this action at the present time
The whole db can be downloaded here, its's only 300 KB. The report is named "rptObjList".
The "bad" code has been commented out. It is an Access 2003 db.
Thanks for your help.
Your code opens a form and checks its .HasModule property. And if the form has a module, you open that module to check .CountOfLines. However, you need not open the module to determine its .CountOfLines. And I would try to avoid opening the form, too.
? VBE.ActiveVBProject.VBComponents("Form_Form1").CodeModule.CountOfLines
6
If you ask for .CountOfLines for a module which doesn't exist, such as the following, you can trap error #9 ('Subscript out of range') to give you an alternative to checking the .HasModule property:
? VBE.ActiveVBProject.VBComponents("bogus").CodeModule.CountOfLines
Or you could check for the code module with a function similar to minimally tested ModuleExists() outlined below.
Note I'm unsure how helpful my suggestions will be because I struggled to follow your code. Furthermore I unwisely chose to step through the code behind rptObjList and became frustrated by all the unhandled errors when it calls GetDesc() for objects which have no Description property. I just gave up.
Public Function ModuleExists(ByVal pModule As String, _
Optional ByVal pProject As String = "") As Boolean
Dim blnReturn As Boolean
Dim objVBProject As Object
Dim strMsg As String
On Error GoTo ErrorHandler
If Len(pProject) = 0 Then
Set objVBProject = VBE.ActiveVBProject
Else
Set objVBProject = VBE.VBProjects(pProject)
End If
blnReturn = Len(objVBProject.VBComponents(pModule).Name) > 0
ExitHere:
Set objVBProject = Nothing
ModuleExists = blnReturn
Exit Function
ErrorHandler:
Select Case Err.Number
Case 9 ' Subscript out of range
' no such module; function returns False
Case Else
strMsg = "Error " & Err.Number & " (" & Err.Description _
& ") in procedure ModuleExists"
MsgBox strMsg
End Select
GoTo ExitHere
End Function