.FindFirst Not Working Properly in Access - ms-access

I am creating a database for contact information for research participants. In it, I have a form with a command button that is supposed to save 1 of 2 possible reports as a pdf for each participant based on the value of one of the text fields on the form (which is linked to a table where the field is automatically calculated as 0 or 2). Basically if the value of this field is 0 then I want the "UnsignedLetter" report saved for that participant or if the value of this field is 2, I want the "SignedLetter" report saved.
I've got most of it working except when it comes to selecting the correct report to save. FindFirst seems to be the closest to being successful but it's not quite right. When I click the button for the code below, the participants coded as 0 get both versions of the report and not just the "UnsignedLetter" version. The same does not happen with the participants coded as 2. For example, on a recordset of 5 people with 3 coded as 2 and 2 coded as 0, I get 3 correct "SignedLetter" pdf's, 2 correct "UnsignedLetter" pdf's, and an additional 2 incorrect "SignedLetter" pdf's. This is the code I'm working with:
Private Sub SaveLetters_Click()
Dim rs As DAO.Recordset
Dim sFolder As String
Dim sFile As String
On Error GoTo Error_Handler
sFolder = Application.CurrentProject.Path & "\"
Set rs = Me.RecordsetClone
With rs
.FindFirst "OncID = 2"
Do While Not .EOF
DoCmd.OpenReport "SignedLetter", acViewPreview, , "[ID]=" & ![ID],
acHidden
sFile = Nz(![UNumber], "") & "_signed" & ".pdf"
sFile = sFolder & sFile
DoCmd.OutputTo acOutputReport, "SignedLetter", acFormatPDF, sFile, , , ,
acExportQualityPrint
DoCmd.Close acReport, "SignedLetter"
.MoveNext
Loop
End With
With rs
.FindFirst "OncID = 0"
Do While Not .EOF
DoCmd.OpenReport "UnsignedLetter", acViewPreview, , "[ID]=" & ![ID], acHidden
sFile = Nz(![UNumber], "") & "_unsigned" & ".pdf"
sFile = sFolder & sFile
DoCmd.OutputTo acOutputReport, "UnsignedLetter", acFormatPDF, sFile, , , ,
acExportQualityPrint
DoCmd.Close acReport, "UnsignedLetter"
.MoveNext
Loop
End With
MsgBox "Letters Sent to File", vbOKOnly + vbInformation, "Task Completed"
Application.FollowHyperlink sFolder
Error_Handler_Exit:
On Error Resume Next
If Not rs Is Nothing Then
rs.Close
Set rs = Nothing
End If
Exit Sub
Error_Handler:
If Err.Number <> 2501 Then
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: cmd_GenPDFs_Click" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occured!"
End If
Resume Error_Handler_Exit
End Sub
I've been searching for 2 days at this point and I can't find any solutions. I've tried doing the 2 With rs's separately, using 1 With rs as after the Then portion of an If .NoMatch statement for the other, changing the calculation so it results in text and not a number, and anything else I can think of or find online. I feel like I'm within throwing distance of tears at this point and would really appreciate any help you guys have.

There is no need for FindFirst. Most of the code for both reports is the same. Use an If Then Else and a variable to select appropriate report and dynamically execute commands.
Dim sRpt As String
With Me.RecordsetClone
Do While Not .EOF
If !OncID = 0 Then
sRpt = "Unsigned"
Else
sRpt = "Signed"
End If
DoCmd.OpenReport sRpt & "Letter", acViewPreview, , "[ID]=" & ![ID], acHidden
DoCmd.OutputTo acOutputReport, , acFormatPDF, _
CurrentProject.Path & "\" & Nz(![UNumber], "") & "_" & sRpt & ".pdf"
DoCmd.Close
.MoveNext
Loop
End With

Related

Email from Access 2010 with Outlook

The code below creates an email. It only works on the first record of the db. Also, the code puts all of the fields in the body. I would like it to only put the fields that have "Request from Finance" in the field.
Private Sub cmdEMail_Click()
On Error GoTo cmdEMail_Click_Error
Dim OutApp As Object
Dim strEMail As String
Dim OutMail As Object
Dim strbody As String
strEMail = Me.EMail
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "Please add the following time codes to Oracle for Lilly Project 1005894. Thank you!" & vbCrLf _
& "" & vbCrLf & "INSTRUCTIONS:" & vbCrLf _
& "" & vbCrLf & "Make sure the Task Description starts with EU. This is automatically added by entering EU in the Contract field on the form." & vbCrLf _
& "" & vbCrLf & "If you wish to keep track of your time code requests, CC: yourself on the e-mail and considering entering a compound name or other identifier in the subject line. Alternatively, save a copy of the spreadsheet with your time codes to your desktop." & vbCrLf _
& "" & vbCrLf & "WRITING TASK NUMBER NAME =" & [Forms]![frm_Regulatory]![WriterTaskNumberName] & vbCrLf _
& "" & vbCrLf & "ADD DRAFT TASK NUMBER NAME =" & [Forms]![frm_Regulatory]![AddDraftTaskNumberName] & vbCrLf _
& "" & vbCrLf & "EDIT TASK NUMBER NAME =" & [Forms]![frm_Regulatory]![EditTaskNumberName] & vbCrLf _
& "" & vbCrLf & "QUALITY REVIEW TASK NUMBER NAME =" & [Forms]![frm_Regulatory]![DataIntegrityQRTaskNumber] & vbCrLf _
& "" & vbCrLf & "Task Description =" & [Forms]![frm_Regulatory]![Text186] & vbCrLf
On Error Resume Next
If Me.ActiveWritingCode = "Request from Finance" Then
With OutMail
.To = strEMail
.CC = ""
.BCC = ""
.Subject = "Lilly EU 1005894 Time Code Request"
.Body = strbody & vbNewLine & .Body
.Display
End With
Set OutMail = Nothing
Set OutApp = Nothing
End If
On Error GoTo 0
Exit Sub
cmdEMail_Click_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdEMail_Click of Sub Form_frm_Regulatory"
End Sub
Here is a generic script to loop through records in a table.
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT * FROM Contacts")
'Check to see if the recordset actually contains rows
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst 'Unnecessary in this case, but still a good habit
Do Until rs.EOF = True
'Perform an edit
'rs.Edit
'rs!VendorYN = True
'rs("VendorYN") = True 'The other way to refer to a field
'rs.Update
'Save contact name into a variable
'sContactName = rs!FirstName & " " & rs!LastName
'Move to the next record. Don't ever forget to do this.
rs.MoveNext
Loop
Else
MsgBox "There are no records in the recordset."
End If
MsgBox "Finished looping through records."
rs.Close 'Close the recordset
Set rs = Nothing 'Clean up
Here is another example which is quite good.
https://msdn.microsoft.com/en-us/library/bb243789(v=office.12).aspx

How to solve vba runtime error 3420

I have the following the detect duplicate product name when user enters a new record.
Private Sub ProdName_BeforeUpdate(Cancel As Integer)
Dim Product As String
Dim stLinkCriteria As String
Dim rsc As DAO.Recordset
Set rsc = Me.RecordsetClone
Product = Me.ProdName.value
stLinkCriteria = "[ProdName]=" & "'" & Product & "'"
If DCount("ProdName", "ProdProduct", stLinkCriteria) > 0 Then
Me.Undo
MsgBox "Warning duplicate entry " _
& Product & " has already been entered." _
& vbCr & vbCr & "You will now be taken to the record.", vbInformation _
, "Duplicate Information"
'Go to record of original product name
rsc.FindFirst stLinkCriteria
Me.Bookmark = rsc.Bookmark
End If
Set rsc = Nothing
End Sub
The code checks and finds duplicate but after it displays the following error and doesn't go to the orginal record:
Run-time error '3420'
Object invalid or no longer set
Please can someone help me get it right?
Try to avoid the undo (or move it to the end) and do cancel the update:
If DCount("ProdName", "ProdProduct", stLinkCriteria) > 0 Then
Cancel = True
MsgBox "Warning duplicate entry " _
& Product & " has already been entered." _
& vbCr & vbCr & "You will now be taken to the record.", vbInformation _
, "Duplicate Information"
'Go to record of original product name
rsc.FindFirst stLinkCriteria
Me.Bookmark = rsc.Bookmark
End If
And you may even skip the DCount and must use the Text property:
Product = Me!ProdName.Text
stLinkCriteria = "[ProdName]=" & "'" & Product & "'"
rsc.FindFirst stLinkCriteria
Cancel = Not rsc.NoMatch
If Cancel = True Then
MsgBox "Warning duplicate entry " _
& Product & " has already been entered." _
& vbCr & vbCr & "You will now be taken to the record.", vbInformation _
, "Duplicate Information"
'Go to record of original product name
Me.Bookmark = rsc.Bookmark
End If
The Run-time Error 3420, Object Invalid or No Longer Set occurs when the form status is dirty, you can simply set the form dirty to false before .findFirst call.
If Me.Dirty Then
Me.Dirty = False
End If
Me.Recordset.FindFirst stLinkCriteria

How to open Access report in a subform/subreport of the main form that houses the controls

I have this MS Access VBA code, using MS Access 2016.
Private Sub cmdPreview_Click()
On Error GoTo Err_Handler
Dim strReport As String
Dim strDateField As String
Dim strWhere As String
Dim lngView As Long
Const strcJetDate = "\#mm\/dd\/yyyy\#"
strReport = "Sales Report V2"
strDateField = "[OrderDate]"
lngView = acViewReport
If IsDate(Me.txtStartDate) Then
strWhere = "(" & strDateField & " >= " & Format(Me.txtStartDate, strcJetDate) & ")"
End If
If IsDate(Me.txtEndDate) Then
If strWhere <> vbNullString Then
strWhere = strWhere & " AND "
End If
strWhere = strWhere & "(" & strDateField & " < " & Format(Me.txtEndDate + 1, strcJetDate) & ")"
End If
If CurrentProject.AllReports(strReport).IsLoaded Then
DoCmd.Close acReport, strReport
End If
DoCmd.OpenReport strReport, lngView, , strWhere
Exit_Handler:
Exit Sub
Err_Handler:
If Err.Number <> 2501 Then
MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, "Cannot open Report"
End If
Resume Exit_Handler
End Sub
The is the the code is use to make date range form work. The form lets you pick a start date and an end date. You then click a button that calls the above code and the report is generated in an new tab. What I want to achieve but have not been able to figure out so far. Is how to make the report show up in a subform/subreport of the form that contains the date range controls and then from there have a button that is clicked to open the generated report in a new tab or printing or whatever if the user is happy with the selection.
This code is from a tutorial located at www.allenbrowne.com/casu-08.html
You can set the Filter property of the enclosed report:
Me!NameOfYourSubreportControl.Report.Filter = strWhere
Me!NameOfYourSubreportControl.Report.FilterOn = True
To open the report the normal way, use your existing code.

Bringing a second column of data into Recordset

I have picked up a project that a prior DBA built before in Access 2010. Currently the coding builds the report, then outputs it in PDF format. Below is the coding in it's current form:
Private Sub Command0_Click()
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("SELECT DISTINCT [Portfolio Code] FROM [General] ORDER BY [Portfolio Code];", dbOpenSnapshot)
Do While Not rst.EOF
strRptFilter = "[Portfolio Code] = " & Chr(34) & rst![Portfolio Code] & Chr(34)
DoCmd.OutputTo acOutputReport, "Main Report", acFormatPDF, "O:\Annual Review\AnnualReviewReport" & "\" & rst![Portfolio Code] & ".pdf"
DoEvents
rst.MoveNext
Loop
rst.Close
Set rst = Nothing
End Sub
What I am trying to do is bring in data from another column in the [General] table from the same row that the [Portfolio Code] is in (it is a name associated with the portfolio ID). The reason is so that I can have the pdf files get sorted into directories by name, e.g.
"O:\Annual Report\AnnualReviewReport\ & [Name] & "\" & [Portfolio Code] & ".pdf"
Is there a way to add the [Name] field into the rst (the name would not be DISTINCT, only the Portfolio Code. I am fairly new at this, so please go easy.
Below is the updated script:
Private Sub Command0_Click()
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("SELECT DISTINCT [Portfolio Code], [Trustee 1] FROM [General] ORDER BY [Portfolio Code];", dbOpenSnapshot)
Do While Not rst.EOF
strRptFilter = "[Portfolio Code] = " & Chr(34) & rst![Portfolio Code] & Chr(34)
DoCmd.OutputTo acOutputReport, "Main Report", acFormatPDF, "O:\Annual Review\AnnualReviewReport" & "\" & rst![Trustee 1] & "\" & rst![Portfolio Code] & " - " & rst![Trustee 1] & ".pdf"
DoEvents
rst.MoveNext
Loop
rst.Close
Set rst = Nothing
End Sub

Access VBA passing parameters vbs file

i am creating a .vbs file that should open access, and inside access a form call "Issue Details", but passing a parameter, meaning that if i have 10 issues in my "Issues" table a vbs file is created for each one and when clicked should open the right record(would be one ID for each record in the table). It is so far opening access and it is opening the form(Issue Details) but it is blank. What am i missing? Help, getting crazy here ... Check code below. The weird thing here is that if i double click it again it will refresh and open the right record without opening anymore windows.. How can i fix that? I dont want to do it twice :)
Public Sub sendMRBmail(mrbid)
DoCmd.OpenForm "Issue Details", , , "[ID] = " & mrbid
End Sub
Private Sub Create_Click()
On Error GoTo Err_Command48_Click
Dim snid As Integer
snid = Me.ID
Dim filename As String
filename = "S:\Quality Control\vbs\QC" & snid & ".vbs"
Dim proc As String
proc = Chr(34) & "sendMRBmail" & Chr(34)
Dim strList As String
strList = "On Error Resume Next" & vbNewLine
strList = strList & "dim accessApp" & vbNewLine
strList = strList & "set accessApp = createObject(" & Chr(34) & "Access.Application" & Chr (34)")" & vbNewLine
strList = strList & "accessApp.OpenCurrentDataBase(" & Chr(34) & "S:\Quality Control\Quality DB\Quality Database.accdb" & Chr(34) & ")" & vbNewLine
strList = strList & "accessApp.Run " & proc & "," & Chr(34) & snid & Chr(34) & vbNewLine
strList = strList & "set accessApp = nothing" & vbNewLine
Open filename For Output As #1
Print #1, strList
Close #1
Err_Command48_Click:
If Err.Number <> 0 Then
MsgBox "Email Error #: " & Err.Number & ", " & "Description: " & Err.Description
Exit Sub
End If
End Sub
This is what is inside a created vbs file
On Error Resume Next
dim accessApp
set accessApp = GetObject("S:\Quality Control\Quality DB\Quality Database.accdb")
accessApp.Run"sendMRBmail","231"
set accessApp = nothing
Thanks to all that made inputs, i already found the answer. I added acFormEdit at the end of my DoCmd and it worked, check below:
DoCmd.OpenForm "Issue Details", , , "[ID] = " & mrbid, acFormEdit