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
Related
I am opening a subform from my main form to allow data to be changed. Once the changes are made, I want to pass the data back to the main form. remove the filter, and go back to the original record. I have the Primary Key in the subform so I am passing it back. I used some code from another user's but it did not work not is my code. Any thoughts?
Private Sub cmd_close_Click()
Dim result As String
Dim ID As Variant
result = MsgBox("Save Geo Location?", vbOKCancel, "Save Geo Location")
If result = vbOK Then
Forms!frm_acct_select!GeoLoc_X = Me.txt_GeoLocX
Forms!frm_acct_select!GeoLoc_Y = Me.txt_GeoLocY
Forms!frm_acct_select.FilterOn = False
'this code fails immediately
With frm_acct_select.Form
ID = Me.txt_ParentID.Value
.FilterOn = False
.Recordset.FindFirst "ParentAccountID=" & ID
End With
'this code fails type mismatch criteria at the recordset.findfirst line
' With Forms!frm_acct_select
' ID = Me.txt_ParentID.Value
' .FilterOn = False
' .Recordset.FindFirst "ParentAccountID = " & ID
' End With
DoCmd.Close acForm, "sfrm_geoloc_update", acSaveNo
Else
DoCmd.Close acForm, "sfrm_acct_select_search", acSaveNo
End If
End Sub
Apparently, I still need to work on my string formatting.
Declaring ID as String was correct however I needed to add quotes to my code.
.Recordset.FindFirst "ParentAccountID = '" & ID & "'"
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.
I'm trying to create a finance database that requires users to sign in and log out. I have that part working correctly. On the homepage of the database, I'm trying to get their last 25 (or X number) of transactions to display using a query. For some reason, I cannot get the code to pass as it shows a "Data type mismatch." Here is the various code - I'll explain each as I go:
Global Variables (My Global Module)
Option Compare Database
'global variables
Global C As Long
Global C2 As Long
Global HoldString As String
Global Flag As Boolean
Global Reply As String
Global mbReply As VbMsgBoxResult
Global User As String
Global GUser As Long
Global db As Database
The following are the Subs() to Log In (First Sub() is for Exit button, second sub() is for sign in button):
Option Compare Database
Private Sub B_Exit_Click()
mbReply = MsgBox(title:="Exit", _
prompt:="Are you sure you wish to exit the system?", _
Buttons:=vbYesNo)
If mbReply = vbNo Then
Exit Sub
Else
DoCmd.Quit acQuitSaveNone
End If
End Sub
Private Sub B_SignIn_Click()
'variables
Set db = CurrentDb()
Dim Employees As DAO.Recordset
Set Employees = db.OpenRecordset("Employees", dbOpenDynaset)
Dim isEmployeed As Boolean
Dim PassMatch As Boolean
Dim isTerm As Boolean
'check to see if the user is in the system
isEmployeed = False
PassMatch = False
isTerm = False
Do While Not Employees.EOF
If Employees![UserName] = T_Username.Value Then
isEmployeed = True
'make sure the employee is not terminated
If Employees![Terminated] = "Yes" Then
isTerm = True
End If
If isTerm = True Then
MsgBox ("This user has been terminated.")
Exit Sub
End If
'make sure password is correct
If Employees![Password] = T_Password.Value Then
PassMatch = True
End If
If PassMatch = False Then
MsgBox ("Incorrect Password.")
Exit Sub
End If
'mark signed in
Employees.Edit
Employees![SignedIn] = 1
Employees.Update
User = Employees![FirstName] & " " & Employees![LastName]
GUser = Employees![ID] 'Sets GUswer to equal record ID.
End If
Employees.MoveNext
Loop
If isEmployeed = False Then
MsgBox ("This username is not in the system.")
Exit Sub
End If
'close this form and open the main menu
Employees.Close
DoCmd.OpenForm FormName:="HomePage"
DoCmd.Close acForm, Me.Name, acSaveNo
End Sub
The next is my SQL code for the query:
SELECT TOP 25 Spend.ID, Spend.Vendor, Spend.MaterialGroup, Spend.GLCode, Spend.CostCenter, Spend.Department, Spend.InvoiceNumber, Spend.InvoiceDate, Spend.Amount, Spend.Tax, Spend.Total, Spend.DateEntered, Spend.DocNumber, Spend.Description, Spend.[Paid?], Spend.EnteredBy, Spend.EnteredBy
FROM Spend
WHERE (((Spend.[EnteredBy])="GUser"));
Spend.[EnteredBy] has a relationship with the Employees table. So EnteredBy is actually a number field because of this relationship.
If I hardcode the "WHERE" statement to be something like (((Spend.[EnteredBy])=2)); then the query will work fine.
Ultimately, what I want to happen is for the query to show the last 25 data entries that the logged on user completed.
Hope this makes sense. If there are questions, please let me know. I feel like I'm missing something small but I cannot figure it out.
Thanks,
Clark
Your query should read:
SELECT TOP 25 Spend.ID, Spend.Vendor, Spend.MaterialGroup, Spend.GLCode, Spend.CostCenter,
Spend.Department, Spend.InvoiceNumber, Spend.InvoiceDate, Spend.Amount, Spend.Tax, Spend.Total,
Spend.DateEntered, Spend.DocNumber, Spend.Description, Spend.[Paid?], Spend.EnteredBy, Spend.EnteredBy
FROM Spend WHERE (((Spend.[EnteredBy])=" & GUser & "));
Note the Ampersands ( & ) I placed before and after your GUser variable. This tells Access to evalute that expression and return the VALUE of it.
I'd also caution you against use the name "User" as a variable name. It's a Reserved Word in Access:
http://office.microsoft.com/en-us/access-help/access-2007-reserved-words-and-symbols-HA010030643.aspx
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