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
Related
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
I wrote a VBA code to print every row of my table into pdf files while creating directories for them.
At first it look great, it doesn't show any kind of error but when the loop ends (around 1200 rows) if I go check the files created, some worked perfectly while others are just blank pages.
Any idea why this might be happening?
Option Compare Database
Private Sub Command0_Click()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim ps As DAO.Recordset
Dim MyFileName As String
Dim mypath As String
Dim temp As String
'mypath = "C:\Docs\"
Set db = CurrentDb()
Set rs = db.OpenRecordset("SELECT * FROM [TABLE]", dbOpenSnapshot)
Do While Not rs.EOF
On Error Resume Next
b = "C:\Docs\" & rs("ENTERPRISE")
MkDir (b)
b1 = "C:\Docs\" & rs("ENTERPRISE") & "\" & "ECONOMICS"
MkDir (b1)
b2 = "C:\Docs\" & rs("ENTERPRISE") & "\" & "ECONOMICS" & "\" & Year(rs("DATE")) & "-" & Month(rs("DATE"))
MkDir (b2)
a = b2 & "\" & rs("NUM") & "-" & rs("ITEM")
MkDir (a)
mypath = a & "\"
temp = rs("DOC_LANC")
MyFileName = rs("NUM") & rs("ITEM") & ".PDF"
DoCmd.OpenReport "PDF", acViewReport, , "[DOC_LANC]='" & temp & "'"
DoCmd.OutputTo acOutputReport, "", acFormatPDF, mypath & MyFileName
DoCmd.Close acReport, "PDF"
DoEvents
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
Set db = Nothing
End Sub
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
I need to print the same report over and over again but with a different name for each report.My reports are printing blank. Not certain how to get code to loop through names in a table and to use those names as a filter for the report. See Code below. Seems to be and issue with rec2.
Option Compare Database
Option Explicit
Sub PrintSingleRepPerPgDailyReportToPDF()
On Error GoTo PrintToPDF_Err
Dim dadb As DAO.Database
Dim rec1 As DAO.Recordset
Dim rec2 As DAO.Recordset
Dim MyFilter As String
Dim MyPath As String
Dim MyFilename As String
Set dadb = CurrentDb
Set rec1 = dadb.OpenRecordset("tblSalesPPL", dbOpenTable)
Do While rec1.EOF = False
Set rec2 = dadb.OpenRecordset("Select [Rep Name] from tblSalesPPL")
MyFilter = "(((tblSales2.Rep)='rec2'))"
MyPath = "C:\Users\Tallahassee Client\Documents\Reports\Reports Daily\" & "AB_"
MyFilename = Month(Now) & "." & Day(Now) & "." & Year(Now) & ".pdf"
DoCmd.OpenReport "rptSales3_SingleRepPerPg_DailyReport_2", acViewPreview, "qrySales3", MyFilter
DoCmd.OutputTo acOutputReport, "", acFormatPDF, MyPath & MyFilename, True
DoCmd.Close acReport, "rptSales3_SingleRepPerPg_DailyReport_2"
PrintToPDF_Exit:
Exit Sub
PrintToPDF_Err:
MsgBox Error$
Resume PrintToPDF_Exit
Set rec2 = Nothing
rec1.MoveNext
Loop
End Sub
If you add Debug.Print MyFilter after MyFilter is defined, you will see that you are filtering the report to match the literal text rec2, not to match the value of the variable named rec2. Change your filter line to:
and see if you have better results.
Set dadb = CurrentDb
Set rec1 = dadb.OpenRecordset("tblSalesPPL", dbOpenTable)
Do While rec1.EOF = False
MyFilter = "Rep='" & Replace(rec1![Rep Name], "'", "''") & "'"
MyPath = "C:\Users\Tallahassee Client\Documents\Reports\Reports Daily\" & "AB_"
MyFilename = Month(Now) & "-" & Day(Now) & "-" & Year(Now) & ".pdf"
DoCmd.OpenReport "rptSales3_SingleRepPerPg_DailyReport_2", acViewPreview, "qrySales3", MyFilter
DoCmd.OutputTo acOutputReport, "", acFormatPDF, MyPath & MyFilename, True
DoCmd.Close acReport, "rptSales3_SingleRepPerPg_DailyReport_2"
rec1.MoveNext
Loop
Set rec1 = Nothing
so that you have a single loop that calls OpenReport once for every record in tblSalesPPL, using the current value of [Rep Name] as the filter for the report's Rep field.
I have a database that I am trying to send information contained on a form combined with selected items in a listbox to a table when the user clicks a Send button. I have the code setup that should copy my information but get a syntax error and I am not sure why... I have tried several different things and can't get it to work. I have included the code below:
Private Sub ctrSend_Click()
Dim intI As Integer
Dim lst As ListBox
Dim varItem As Variant
Set lst = Me![lstShipping]
With lst
If .ItemsSelected.count = 0 Then Exit Sub
For Each varItem In .ItemsSelected
CurrentDb.Execute "INSERT INTO ShipInv ([Order], [ShipDate], [BIN], [SKU], [Lot], [QtyProd])" _
"VALUES ('" & Me.[ctrSOrder] & "'," & Me.[ctrSDate] & ",'" & .Column(0, varItem) & "'," & .Column(1, varItem) & "," & .Column(2, varItem) & "," & .Column(3, varItem) & ");", dbFailOnError
Next
End With
End Sub
For a situation like this, I always reccommend using a string to hold the constructed SQL so that you can easily print the string to the immediate window to check how certain values have broken your SQL.
So, try adding
Dim strSQL As String
strSQL = "INSERT INTO ShipInv ([Order], [ShipDate], [BIN], [SKU], [Lot], [QtyProd])" _
"VALUES ('" & Me.[ctrSOrder] & "'," & Me.[ctrSDate] & ",'" & .Column(0, varItem) & "'," & .Column(1, varItem) & "," & .Column(2, varItem) & "," & .Column(3, varItem) & ");"
Debug.Print strSQL
CurrentDb.Execute strSQL 'remove dbFailOnError temporarily so that failure will stop code
My blind guess is that if ShipDate is a date field(not text), you'll need to format that value with Format(Me.[ctrSDate], "\#mm\/dd\/yyyy\#" before pasting it into the SQL.
I used a different approach and it works out great...
Private Sub ctrSend_Click()
Dim intI As Integer
Dim lst As ListBox
Dim varItem As Variant
Dim rst As DAO.Recordset
Set lst = Me![lstShipping]
Set rst = CurrentDb.OpenRecordset("ShipInv", dbOpenTable)
With lst
If .ItemsSelected.count = 0 Then Exit Sub
For Each varItem In .ItemsSelected
rst.AddNew
rst!Order = Me.[ctrSOrder]
rst!EntDate = Date
rst!ShipDate = Me.[ctrSDate]
rst!BIN = .Column(0, varItem)
rst!SKU = .Column(1, varItem)
rst!Lot = .Column(2, varItem)
rst!QtyProd = .Column(3, varItem)
rst.Update
Next
End With
rst.Close
Set rst = Nothing
MsgBox "Warehouse Inventory Updated", vbOKOnly, "Inventory Confirmation"
End Sub