I am trying to print a separate pdf file (billing invoice) from a form for each record in my database.
Form to print: BillingInvoice-
Source for form: FamilySubDIscSubDIscGrand
Primary field: Fnum
I've tried taking code from here:
How to output multiple PDF files based on record in MS Access?
This is the code that code as I have tried to modify it:
Option Compare Database
Option Explicit
Private Sub PrintBtn01_Click()
Dim rsGroup As DAO.Recordset
Dim ColumnName As String, myPath As String
myPath = "C:\test\"
Set rsGroup = CurrentDb.OpenRecordset("SELECT DISTINCT FNum FROM FamilySubDIscSubDIscGrand", _
dbOpenDynaset)
Do Until rsGroup.EOF
ColumnName = rsGroup!FNum
' OPEN FORM, FILTERING RECORDSOURCE BY COLUMN VALUE
DoCmd.OpenForm "BillingInvoice-", acViewPreview, , "Column='" & ColumnName & "'"
' OUTPUT FORM TO FILE
DoCmd.OutputTo acOutputForm, "BillingInvoice-", acFormatPDF, _
myPath & ColumnName & ".pdf", False
rsGroup.MoveNext
Loop
End Sub
I’m doing something wrong.
It is successfully saving the pdf’s with the FNums in sequence, but printing the individual records for each FNum, it is printing all the records. So I end up with:
FNum001.pdf (all records for db)
FNum002.pdf (all records for db)
Fnum003.pdf (all records or db)
...
But what I need is:
FNum001.pdf (individual record for FNum001)
FNum002.pdf (individual record for FNum002)
FNum003.pdf (individual record for FNum003)
...
If FNum is numerical, you should not surround the criteria value with single quotes, i.e. this:
"Column='" & ColumnName & "'"
Should become:
"Column=" & ColumnName
Also, unless you have a field on your form called Column, this should be changed to:
"FNum = " & ColumnName
Related
I have a VBA script in MS Access that inserts a new record into a SQL Server table based on some inputs on the form.
Private Sub Allocate_Click()
Dim strSQL As String
strSQL = "INSERT INTO dbo_ALLOCATIONS " _
& "([Employee No],[Device Serial Number],[Start Date]) VALUES " _
& "('" & Me.EmployeeNumber & "', '" & Me.SerialNumber & "', '" & Me.StartDate & "')"
CurrentDb.Execute strSQL, dbFailOnError
Dim ReceiptNo As dao.Recordset
Set ReceiptNo = CurrentDb.OpenRecordset("select ##identity")
MsgBox "Device Successfully Allocated. Receipt ID is " & CurrentDb.OpenRecordset("select ##identity")
End Sub
At the end, I query the ID that was auto-incremented during the insert. I want to then quote this in a Message Box so the user can make use of it elsewhere. How can I get it to quote like that in the MsgBox command? The one I have at the moment causes lots of issues around the fact I can't combine this command, and when using only 'ReceiptNo' it says it's not a string.
There should only ever be a single result in the recordset. Try changing your last line to:
MsgBox "Device Successfully Allocated. Receipt ID is " & ReceiptNo(0)
It is not possible to print an entire recordset. You need to refer to the column that you want to print and loop through the recordset while the end of file is not reached. Then output your column as string. I did not test it though.
While not ReceiptNo.EOF
Msgbox Str(ReceiptNo!Identity)
ReceiptNo.moveNext
Wend
Let me explain the WEIRDEST client requirement, we're scratching our heads for:
We have an MS Access VBA application with thousands of forms fields in hundreds of forms.
A few fields in these forms populates data from few tables/queries.
A few other fields in forms inserts data to few tables through queries/direct code.
Notice that these tables are linked tables to SQL Server tables.
Is there a way to find which form field is related to which table column in?
Hence, we need some tool/macro to do this.
How do we find which form field points to which database fields in MS Access?
Based on #ClintB's answer, we have prepared the following code. The values in ctl.ControlSource doesn't seems to be referring to actual database objects:
Sub GetFormFieldToDBFieldMapping()
Dim frm As Object
Dim LiveForm As Form
Dim ctl As control
Dim i As Integer
Dim fso As Object
Dim ctlSource As String
Set fso = CreateObject("Scripting.FileSystemObject")
Dim oFile As Object
Set oFile = fso.CreateTextFile("D:\ControlSources.txt")
For Each frm In Application.CurrentProject.AllForms
'To access form controls, open it
DoCmd.OpenForm frm.Name, acViewDesign
Set LiveForm = forms(frm.Name)
For i = 0 To LiveForm.Controls.Count - 1
Set ctl = LiveForm.Controls.Item(i)
If ctl.ControlType = 106 Or ctl.ControlType = 111 Or ctl.ControlType = 110 Or ctl.ControlType = 109 Then
ctlSource = ctlSource & vbCrLf & "Form Name :" & LiveForm.Name & ": Control Name :" & ctl.Name & ": Control Source :" & ctl.ControlSource
End If
Next i
'Do not forget to close when you are done
DoCmd.Close acForm, frm.Name
Next
oFile.WriteLine ctlSource
oFile.Close
Set fso = Nothing
Set oFile = Nothing
End Sub
I Would do something like this. (not actual code)
For each form in db
For each control in form
'Write a record to a table stating which formName, controlName and the control.controlSource
Next
Next
Edit: ControlSource, not RowSource
The code, you've came up with is excellent! This will give you:
Form Name
Control Name
Control Source
The only thing you need is the table name to which the column is coming.
Since, the tables are tables linked to SQL server, you can find all the tables with all their columns.
This will give you:
Table Name
Column Name
Keep both these information in two excel sheets.
Do a V-Lookup on column name to find the table name
I want to populate a List Box on a Word User Form based on the data entered in a Text Box on the same form. Ideally this would happen in real time (using the change event I think) with each character entered in the Text Box filtering the items that appear in the List Box.
The data source is an Excel "data base" accessed using DAO. The code below works but it enters the entire data base into List Box (based on this - Link).
Private Sub UserForm_Initialize()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim NoOfRecords As Long
'Open the database (Excel File)
Set db = OpenDatabase("C:\Users\T400\Documents\UserFormListTest.xlsx" _
, False, False, "Excel 8.0")
'Retrieve the recordset > Excel Range = "ListBoxData"
Set rs = db.OpenRecordset("SELECT * FROM ListBoxData")
' Determine the number of retrieved records
With rs
.MoveLast
NoOfRecords = .RecordCount
.MoveFirst
End With
' Set the number of Columns = number of Fields in recordset
ListBox1.ColumnCount = rs.Fields.Count
ListBox1.Column = rs.GetRows(NoOfRecords)
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
End Sub
How can I filter the data so the List Box is only populated per the Text Box? I was hoping for a simple solution like maybe modifying the SELECT * query portion of the code.
Is this possible? Or is there a better way?
As i mentioned in the comment to the question, MS Excel uses Jet database engine. So, you have to use wildcards which correspond to that database engine.
So, if you want to develop custom "search/find" functionality, you may add Combobox control on the form with these options: All, StartsWith, Contains and EndsWith. A sample code should look like (replace the name of controls to yours):
Dim sName As String
Dim sSearchType As String
Dim sQry As String
sName = TextBox1.Text
sSearchType = ComboBox1.Value
sQry = "SELECT * FROM ListBoxData "
Select Case sSearchType
Case "All"
'do nothing; return all records
Case "StartsWith"
sQry = sQry & "WHERE Name Like '" & sName & "*'"
Case "Contains"
sQry = sQry & "WHERE Name Like '*" & sName & "*'"
Case "EndWith"
sQry = sQry & "WHERE Name Like '*" & sName & "'"
End Select
Set rs = db.OpenRecordset(sQry)
'other stuff
More about wildcards, you'll find here:
Access wildcard character reference
Office: Wildcard Characters used in String Comparisons
I am working writing out reports from our company database using VBA and MS Access 2010. I have almost 3000 employees and I need to write out 10 different reports for each employee and then combine those 10 reports into one pdf per employee. These files are then saved in directories that are sorted by their duty station.
The code I have written works great and does the job intended to do EXCEPT after writing out 1024 reports I receive an error. Err.Number 3014, Cannot open anymore tables.
According to what I could find on the internet this has to do with the Jet table references and is tricky to troubleshoot. I have followed what advice I could find I believe I have properly closed out everything after use. I thought maybe the problem arose in the merge pdf files routine but even if you comment that out it still fails at 1024 reports.
I would like this code to be able to process about 30,000 reports without failing. Any ideas or thoughts would be appreciated.
Public Function combined_report(EmployeeSelectionQuery As String)
Dim DefaultPdfDir As String ' contains path to where pdf files will be written on local computer
Dim rst As Recordset ' recordset object for set of selected plots from query:Employees_COMBINED
Dim n_employees As Integer ' Number of employees selected by query:Employees_COMBINED
Dim current_employee_number As Variant ' current employee number, used when writing combined reports
Dim current_duty_station As Variant ' current duty station, used when writing combined reports
Dim strWhere As String ' String containing the where clause for the combined openreport WhereCondition
Dim arrayReport(0 To 9) As Variant ' Array containing all the reports to be processed in combined
Dim strReport As Variant ' String containing prefix to reports
Dim tempOutputPdfFile As String ' Individual report before they are combined
Dim combinedOutputPdfFile As String ' Combined report composed of individual reports REQUIRES that adobe acrobat - full version be installed.
Dim intCounter As Integer ' A iteration counter used to update the status bar
Dim combOutputPdfFile As String ' Combined Output Pdf File Path
On Error GoTo error_handler
Set rst = CurrentDb.OpenRecordset(EmployeeSelectionQuery)
'Force Access to accurately update .RecordCount property
rst.MoveLast
rst.MoveFirst
n_employees = rst.RecordCount
If n_employees = 0 Then
Call MsgBox("No employees selected by query: " & EmployeeSelectionQuery, vbCritical + vbOKOnly + vbDefaultButton1, "No Employees Selected")
combined_report = False
Else
DoCmd.Hourglass True
'Set HomeDir and create output folder
DefaultPdfDir = "C:\temp"
MakeDir DefaultPdfDir
arrayReport(0) = "REPORT_1"
arrayReport(1) = "REPORT_2"
arrayReport(2) = "REPORT_3"
arrayReport(3) = "REPORT_4"
arrayReport(4) = "REPORT_5"
arrayReport(5) = "REPORT_6"
arrayReport(6) = "REPORT_7"
arrayReport(7) = "REPORT_8"
arrayReport(8) = "REPORT_9"
arrayReport(9) = "REPORT_10"
'Set counter to zero
intCounter = 0
Do While (Not (rst.EOF))
'Get employee number and duty station to name the files and sort by directory
current_employee_number = rst!EN
current_duty_station = rst!DUTY_STATION
'Make the output directory if it doesn't exist and specify the output file path
MakeDir "C:\Final\" & current_duty_station
combOutputPdfFile = "C:Final\" & current_duty_station & "\" & current_employee_number & ".pdf"
'Increment counter by one for each employee processed
intCounter = intCounter + 1
'Where statement used by DoCmd.OpenReport to run the report for one employee only
strWhere = "[EN] = " & current_employee_number & " OR [en] = " & current_employee_number
'Process each report
For Each strReport In arrayReport
'Specify the file path and name for the report
tempOutputPdfFile = DefaultPdfDir & "\" & current_employee_number & "_" & strReport & ".pdf"
'Update Status Bar
Status ("Processing " & intCounter & " of " & n_employees & ": " & tempOutputPdfFile)
'Open the report and write it to a pdf file
DoCmd.OpenReport strReport, acViewPreview, "", strWhere, acHidden
DoCmd.OutputTo acOutputReport, strReport, acFormatPDF, tempOutputPdfFile, False
DoCmd.Close acReport, strReport, acSaveNo
'Merge the files
MergePdfFiles combOutputPdfFile, tempOutputPdfFile, combOutputPdfFile
Next strReport
'Delete the last temp file before moving on to the next employee
DeleteFile tempOutputPdfFile
rst.MoveNext
Loop
'Close everything up
Status ("")
rst.Close
Set rst = Nothing
DoCmd.Hourglass False
combined_report = True
End If
Exit Function
error_handler:
MsgBox "Error: " & Err.Number & vbNewLine & _
"Description: " & Err.Description, vbCritical, "combined_report function error"
DoCmd.Hourglass False
combined_report = False
Status ("")
End Function
Try commenting out the "DoCmd.OutputTo" statement, see if it errors. I am guessing this command is opening a report in addition to the report being opened in the prior DoCmd.OpenReport line.
(I would have just added this as a comment, but SO wouldn't let me)
I was using DoCmd.OpenReport because it had the WHERE clause functionality built in. After reading JayRO-GreyBeard's comment I realized that it did seem redundant to use both the OpenReport and OutputTo methods. So, I rewrote the code, removing the OpenReport call and modified the QueryDef for each report prior to calling OutputTo.
For some reason this worked around the problem.
Thanks for the help!
I had the same issue with the 3014 Error. I was outputting the report to PDF, while displaying the report on the screen for the user (using both Docmd.OpenReport and Docmd.OutputTo, which worked fine for single reports. However, when I would batch run reports and export/display the reports. (The tool auto generates Purchase Orders) The 3014 error would occur around 100 or so reports.
When I turned off the DoCmd.OpenReport for the batch run of reports to PDF. The 3014 error went away. I have retested, and can not run report batches in the 1000s with no problem.
I have a form with an unbound combobox that has all the column headings for the table dbo_orderheader. What I want to do is use the combobox field to act as the table column header instead of hard coding it to a specific table column header, that way a user can search dynamically from the form on the column they choose instead of having a huge list of search boxes for each table column.
Please can anyone help on a way to do this in an access query? I am using Access 2007.
Thanks.
See Picture Attached
I'm pretty sure that there's no way to imbed a form reference as a column heading in a static query design, but you could use code behind your form to dynamically update the query design and then open the query, something like this
Private Sub btnOpenQuery_Click()
Dim cdb As DAO.Database, qdf As DAO.QueryDef
Const queryName = "flexQuery"
Set cdb = CurrentDb
DoCmd.Close acQuery, queryName, acSaveNo
On Error Resume Next
DoCmd.DeleteObject acQuery, queryName
On Error GoTo 0
Set qdf = cdb.CreateQueryDef(queryName, _
"SELECT URN, StyleNo, [" & Me.Combo3.Value & "] " & _
"FROM dbo_OrderHeader " & _
"WHERE [" & Me.Combo3.Value & "]=""" & Me.Text5.Value & """" _
)
Set qdf = Nothing
Set cdb = Nothing
DoCmd.OpenQuery queryName, acViewNormal
End Sub
Note: This sample code assumes that the "dynamic" column is a Text column, so it puts " characters around the Text5.Value when constructing the SQL statement. This code would have to be enhanced to handle other column types (e.g., no quotes for numeric columns, and perhaps # delimiters for dates).