I want to print each record to a separate pdf file using certain field for filename.
My code's output does not show the values as shown in the pictures.
Private Sub Command_PDF_Click()
Dim myrs As Recordset
Dim myPDF, myStmt As String
myStmt = "Select distinct Code1 from Query_Certificate_Eng"
Set myrs = CurrentDb.OpenRecordset(myStmt)
Do Until myrs.EOF
myPDF = "C:\Users\93167\Desktop\Output Certificate\" & Format(myrs.Fields("Code1"), "0000000000000") & ".pdf"
DoCmd.OpenReport "Certificate_Eng", acViewPreview, , "Code1" = " & myrs.Fields("").value"
DoCmd.OutputTo objectType:=acOutputReport, objectName:="Certificate_Eng", outputformat:=acFormatPDF, outputfile:=myPDF, outputquality:=acExportQualityPrint
DoCmd.Close
myrs.MoveNext
Loop
myrs.Close
Set myrs = Nothing
End Sub
Problem is in your report opening criteria. So, change it to
"Code1 = '" & myrs!Code1 & "'"
Related
I have a form with textboxes and one combobox which has the order number, and one command to print the form as PDF and save it to specific folder and then attach it to the attachment column on the same orders table with the same order number selected from my combobox
I made this code below but I am facing this issue
**
It is working and saving PDF file now, but how can I manage to attach the same file to the attachment field in the same table with the same order number row?
I tried the following code to attach but it is not finding the record by Order number
Private Sub Command8_Click()
Dim FileName As String
Dim filepath As String
Dim rst As DAO.Recordset
Dim attachFld As DAO.Recordset
Dim db As DAO.Database, rs As DAO.Recordset, rsAtt As DAO.Recordset2
FileName = Me.Order_Number
filepath = "C:\Users\pc\Desktop\Newfolder\" & FileName & ".pdf"
Forms("Receipt").Filter = "[Order]=" & Me![Order] & ""
Forms("Receipt").FilterOn = True
DoCmd.OutputTo acOutputForm, "Receipt", acFormatPDF, filepath
'DoCmd.Save acForm, "Receipt"
'DoCmd.Close acForm, "Receipt", acSaveNo
' to SAVE ATTACHMENT
'Dim fPath As String: fPath = "C:\Users\india\Desktop\New folder (2)\New folder\"
Set db = CurrentDb
Set rs = db.OpenRecordset("WorkOrders")
If Dir(filepath & rs.Fields("Order").value & ".pdf") <> "" Then
rs.Edit
Set rsAtt = rs.Fields("Attachment").value
With rsAtt
.AddNew
.Fields("Attachment").LoadFromFile (filepath & rs.Fields("ID").value & ".pdf")
.Update
End With
rs.Update
End If
End Sub
**
Private Sub Command8_Click()
Dim FileName As String
Dim FilePatch As String
FileName = "Order_No_" & Me.Order_Number
Filepath = "C:\Users\pc\Desktop\Newfolder" & FileName & ".pdf"
Forms("Receipt").Filter = "[Order]='" & Me![Order] & "'"
Forms("Receipt").FilterOn = True
DoCmd.OutputTo acOutputForm, "Receipt", acFormatPDF, Filepath
'DoCmd.Save acForm, "Receipt"
DoCmd.Close acForm, "Receipt", acSaveNo
End Sub
I'm having an issue with an access form/report as it's not printing to the printer I've chosen from a combobox (that lists all the available printers).
I do know that I did create the report through the designer with the printer zebra-01 set and I think this is what might be causing the problem.
I have the following code to print labels from the report:
'Option Compare Database
Private Sub btnPrint_Click()
'Validate Input Given. If the input is less than or equal to 0 discard the print command.
'Two If statements, one for validating the input type and if the input is a positive number.
If IsNull(Me.txtNumberOfLabels) Or Not IsNumeric(Me.txtNumberOfLabels.Value) Then
MsgBox "O valor introduzido não é um valor numérico.", _
vbOKOnly, "Erro"
DoCmd.GoToControl "txtNumberOfLabels"
Exit Sub
End If
If Me.txtNumberOfLabels.Value <= 0 Then
MsgBox "O número de etiquetas a imprimir deve ser superior a 0", _
vbOKOnly, "Erro"
DoCmd.GoToControl "txtNumberOfLabels"
Exit Sub
End If
Dim availablePrinters As Printer
Dim selectedPrinter As String
DoCmd.GoToControl "cbPrintersList"
selectedPrinter = Me.cbPrintersList.Text
For Each availablePrinters In Application.Printers
If availablePrinters.DeviceName = selectedPrinter Then
Set Application.Printer = availablePrinters
Exit For
End If
Next availablePrinters
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim lastLabelRecordIndex_Part1 As String
Dim lastLabelRecordIndex_Part2 As String
Dim lastLabelRecordIndex_Part3 As String
Dim oldLastLabelRecordIndex_Part1 As String
Dim oldLastLabelRecordIndex_Part2 As String
Dim oldLastLabelRecordIndex_Part3 As String
Dim strSQL As String
Set db = CurrentDb
strSQL = "SELECT MAX(Pre_SSCC) As MaxRecord FROM SSCC_Gen"
Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot)
oldLastLabelRecordIndex_Part1 = CStr(Left(rs("MaxRecord"), 8))
oldLastLabelRecordIndex_Part2 = CStr(Mid(rs("MaxRecord"), 9, 4))
oldLastLabelRecordIndex_Part3 = CStr(Right(rs("MaxRecord"), 5))
rs.Close
db.Close
Dim labelRecordIndex As Long
DoCmd.SetWarnings False
For labelRecordIndex = CLng(oldLastLabelRecordIndex_Part3) To CLng(oldLastLabelRecordIndex_Part3) + Me.txtNumberOfLabels.Value - 1
DoCmd.RunSQL "INSERT INTO SSCC_GenCount (Data) VALUES (#" & Format(Now(), "dd/mm/yyyy") & "#)"
Next labelRecordIndex
DoCmd.SetWarnings True
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot)
lastLabelRecordIndex_Part1 = CStr(Left(rs("MaxRecord"), 8))
lastLabelRecordIndex_Part2 = CStr(Mid(rs("MaxRecord"), 9, 4))
lastLabelRecordIndex_Part3 = CStr(Right(rs("MaxRecord"), 5))
rs.Close
db.Close
Dim oldLastLabelRecordIndex As String
Dim lastLabelRecordIndex As String
oldLastLabelRecordIndex = oldLastLabelRecordIndex_Part1 & oldLastLabelRecordIndex_Part2 & CStr(oldLastLabelRecordIndex_Part3 + 1)
lastLabelRecordIndex = lastLabelRecordIndex_Part1 & lastLabelRecordIndex_Part2 & lastLabelRecordIndex_Part3
DoCmd.SetWarnings False
DoCmd.OpenReport Report_Labels_SSCC_Gen.Name, acViewPreview, , "Pre_SSCC BETWEEN '" & CStr(oldLastLabelRecordIndex) & "' AND '" & CStr(lastLabelRecordIndex) & "'", acHidden
Set Report_Labels_SSCC_Gen.Printer = Application.Printers(Me.cbPrintersList.ListIndex)
'MsgBox Report_Labels_SSCC_Gen.Printer.DeviceName
DoCmd.OpenReport Report_Labels_SSCC_Gen.Name, , , "Pre_SSCC BETWEEN '" & CStr(oldLastLabelRecordIndex) & "' AND '" & CStr(lastLabelRecordIndex) & "'", acHidden
DoCmd.Close acReport, Report_Labels_SSCC_Gen.Name, acSaveNo
DoCmd.SetWarnings True
End Sub
And this is the code to populate the combobox with the list of available printers, as soon as the form comes up:
Private Sub Form_Load()
Dim printerIndex As Integer
For printerIndex = 0 To Application.Printers.Count - 1
Me.cbPrintersList.AddItem (Application.Printers(printerIndex).DeviceName)
Next printerIndex
DoCmd.GoToControl "cbPrintersList"
End Sub
Now, according to dozens of articles I've read the whole day, the following bit of code should set the printer I want to print to, but it still keeps sending to the zebra-01 printer:
DoCmd.OpenReport Report_Labels_SSCC_Gen.Name, acViewPreview, , "Pre_SSCC BETWEEN '" & CStr(oldLastLabelRecordIndex) & "' AND '" & CStr(lastLabelRecordIndex) & "'", acHidden
Set Report_Labels_SSCC_Gen.Printer = Application.Printers(Me.cbPrintersList.ListIndex)
'MsgBox Report_Labels_SSCC_Gen.Printer.DeviceName
DoCmd.OpenReport Report_Labels_SSCC_Gen.Name, , , "Pre_SSCC BETWEEN '" & CStr(oldLastLabelRecordIndex) & "' AND '" & CStr(lastLabelRecordIndex) & "'", acHidden
DoCmd.Close acReport, Report_Labels_SSCC_Gen.Name, acSaveNo
Can anyone explain to me what am I missing or doing wrong?
As a reference, here's what's happening before and after the printer is set to the report.printer property:
Before setting the printer
After setting the printer
You can clearly see from the debug that the report has its printer property set to the printer I've chosen from the combobox.
However, for some reason I cannot understand, right after that line of code, when running the OpenReport to print the labels, it prints to zebra-01 printer instead...
Personally, I use the following code to print reports to a specified printer:
DoCmd.OpenReport "SomeReport", acViewPreview
Set Reports("SomeReport").Printer = Application.Printers("SomePrinter")
DoCmd.SelectObject acReport, "SomeReport"
DoCmd.PrintOut
DoCmd.Close
This only works with reports that are not printing to the default printer, so first open up the report in design view, go to page setup, and choose Use specific printer, then pick a printer (any printer), to make sure the report won't be printed on the system default printer.
If you want to specify paper size and bin, you can do so after setting the report printer:
DoCmd.OpenReport "SomeReport", acViewPreview
Set Reports("SomeReport").Printer = Application.Printers("SomePrinter")
Reports("SomeReport").Printer.PaperSize = 1
Reports("SomeReport").Printer.PaperBin = 2
DoCmd.SelectObject acReport, "SomeReport"
DoCmd.PrintOut
DoCmd.Close
Getting the right numbers for the paper and bin numbers is a bit complicated, however. The process is outlined here: https://learn.microsoft.com/en-us/office/vba/access/concepts/printing/programmatically-retrieve-printer-capabilities
I have a recordset that I'm looping through and would like to create a report that displays information for each user ID in the recordset. I've found many posts that have helped me to write the code, but I cannot figure out why my code keeps opening the report with all user IDs instead of each user ID individually. Here's the code I'm using:
Public Function report()
Dim rs As Recordset
Dim strReportName As String
Dim fileName, pathName As String
pathName = "C:\Users\Joe\Documents"
Set rs = CurrentDb.OpenRecordset("SELECT Add_user, keyer FROM qryProductionReport;")
strReportName = "ProductionReport"
Do While Not rs.EOF
DoCmd.OpenReport strReportName, acViewPreview, , "Add_user = " & rs!Add_user, acHidden
DoCmd.OutputTo acOutputReport, strReportName, acFormatPDF, pathName & strReportName & rs!Keyer & ".PDF"
DoCmd.Close acReport, strReportName
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
End Function
I made sure that my field name Add_user on the report matches the filter that I have in the DoCmd.OpenReport line. I'm using Access 2016. Thanks for the help.
One way is to modify your report to use a TempVars criteria
(e.g. [TempVars]![userId]) as explained here.
You can then use it like this:
Public Function report()
Dim rs As Recordset, strReportName As String
Dim fileName as String, pathName As String
pathName = "C:\Users\Joe\Documents\"
Set rs = CurrentDb.OpenRecordset("SELECT Add_user, keyer FROM qryProductionReport;")
strReportName = "ProductionReport"
Do While Not rs.EOF
TempVars("userId") = rs!Add_user
DoCmd.OutputTo acOutputReport, strReportName, acFormatPDF, pathName & strReportName & rs!Keyer & ".PDF"
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
End Function
I'm trying to save each individual employees statement using Access Reports. However I'm having issues with getting the Employee Name field to append to the MyFileName variable.
I'm able to export the individual employee reports as a PDF with the following format:
Statement_[EENo].pdf
However, I would like to have this to include the employee name in the following format:
Statement_[Employee Name]_[EENo].pdf
Private Sub Command2_Click()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim MyFileName As String
Dim mypath As String
Dim temp As String
mypath = "FILE LOCATION"
Set db = CurrentDb()
Set rs = db.OpenRecordset("SELECT distinct [EENo] & [Employee Name] FROM [Query]", dbOpenSnapshot)
rs.MoveFirst
Do While Not rs.EOF
temp = rs("EENo" & "Employee Name")
MyFileName = "Statement" & "_" & [Employee Name] & "_" & Format(rs("EENo"), "000000") & ".PDF"
DoCmd.OpenQuery "1 - Query: Firm Admin_EE"
DoCmd.Close acQuery, "1 - Query: Firm Admin_EE", acSaveYes
DoCmd.OpenReport "REPORT", acViewReport, , "[EENo]=" & temp
DoCmd.OutputTo acOutputReport, "", acFormatPDF, mypath & MyFileName
DoCmd.Close acReport, "REPORT"
DoEvents
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
Set db = Nothing
End Sub
This should work:
temp = rs("EENo").Value & rs("Employee Name").Value
MyFileName = "Statement_" & rs("Employee Name").Value & "_" & _
Format(rs("EENo").Value, "000000") & ".PDF"
EDIT: I had not really looked at your SQL, and missed that you're combining the two columns in your query. I don't use access but try:
Set rs = db.OpenRecordset("SELECT distinct [EENo] , [Employee Name] FROM [Query]", _
dbOpenSnapshot)
I have a table, which was pulled out of some XML data. I'm trying to do a cross reference, so I can line out a plan for organizing the data. This 1 table has a list of variables. Fields of different data types, computations, as well as dialogs. One of the columns has options. If the data type of the variable is a dialog, its options has a list of variables, separated by a semi-colon.
So the main table has a structure like so:
For the dialog records I need to look through their options column and insert records into a normalized table. For each field, in that column, I want to add a record with that dialog name, and the ID of the row in that table (I added a PK to the table). For instance, in the dialog record, Options column, there is a field in there called BusinessName TE. I need to search this main table for the PK ID of the row that has a variable name of the same. I need to put that record's ID with the name of the dialog, and insert both into a new table I set up. This will create a cross reference for me, so I can know which variables are being used by which dialogs.
I appreciate any help anyone can give. I see stuff about using a split function, arrays and looping through to get each value, but the examples I'm finding are for strings, not a column in a table.
Thanks!
Edit: Adding in the VBA code I'm working with. I attached it to a button on a form, just so I could click to run it.
Private Sub RunParse_Click()
Dim db As DAO.Database
Dim rs As Recordset
Set db = CurrentDb()
Dim sqlStr, insertSQL, arrayVal As String
Dim TestArray As Variant
Dim Options As String
Dim Dialog As String
Dim FieldName As Long
Dim i As Integer
sqlStr = "SELECT [MASTER Fields].Options,[MASTER Fields].[Variable Name] FROM [MASTER Fields] WHERE ((([MASTER Fields].[Variable Type])='dialog'));"
Set rs = db.OpenRecordset(sqlStr)
rs.MoveLast
rs.MoveFirst
Do While Not rs.EOF
Options = rs.Fields(0)
Dialog = rs.Fields(1)
If InStr(Options, ";") Then
TestArray = Split(Options, ";")
For i = 0 To UBound(TestArray) - LBound(TestArray) + 1
If TestArray(i) <> "" Then
arrayVal = TestArray(i)
FieldName = DLookup("ID", "MASTER Fields", "[Variable Name] = " & "'" & arrayVal & "'")
insertSQL = "INSERT INTO FieldTemplatesUse(FID, TemplateAK) " _
& "VALUES(""" & FieldName & """, """ & Dialog & """)"
DoCmd.RunSQL (insertSQL)
End If
Next i
End If
rs.MoveNext
Loop
End Sub
right now on the line that says
If TestArray(i) <> "" Then
creates an error ""
If anyone can help, I'd really appreciate it!
Another Edit:
Parfait figured out my issue. I'm posting the final code I am using, in case it helps someone else! p.s. I added a condition to check if the dlookup is successful, and trap failures in a failures table. That way I can check those out afterward.
Private Sub RunParse_Click()
Dim db As DAO.Database
Dim rs As Recordset
Set db = CurrentDb()
Dim sqlStr, insertSQL, arrayVal As String
Dim TestArray As Variant
Dim Options As String
Dim Dialog As String
Dim FieldName As Long
Dim i As Integer
sqlStr = "SELECT [Master Fields].Options,[Master Fields].[Variable Name] FROM [Master Fields] WHERE ((([Master Fields].[Variable Type])='dialog'));"
Set rs = db.OpenRecordset(sqlStr)
rs.MoveLast
rs.MoveFirst
Do While Not rs.EOF
Options = rs.Fields(0)
Dialog = rs.Fields(1)
If InStr(Options, ";") Then
TestArray = Split(Options, ";")
For i = 0 To UBound(TestArray) - LBound(TestArray)
If TestArray(i) <> "" Then
arrayVal = TestArray(i)
If Not (IsNull(DLookup("ID", "Master Fields", "[Variable Name] = " & "'" & arrayVal & "'"))) Then
FieldName = DLookup("ID", "Master Fields", "[Variable Name] = " & "'" & arrayVal & "'")
insertSQL = "INSERT INTO FieldTemplatesUse(FID, TemplateAK) " _
& "VALUES(""" & FieldName & """, """ & Dialog & """)"
DoCmd.RunSQL (insertSQL)
'MsgBox "Adding ID = " & FieldName & "for Dialog: " & Dialog & "Now"
Else
insertSQL = "INSERT INTO tblFieldsNotFound(Dialog, FieldNotFound) " _
& "VALUES(""" & Dialog & """, """ & arrayVal & """)"
DoCmd.RunSQL (insertSQL)
End If
End If
Next i
End If
rs.MoveNext
Loop
MsgBox "All Done!"
End Sub