In the following code I am setting a True/False field in order to print reports using the user's input
but the last record is not printed,
If I comment out the last loop (the loop to set all to false) I get all records printed but I need to set them all back to False
Sub PrintReports()
Dim rst As Recordset
Dim startDate As Date
Dim endDate As Date
' Prompt user to enter start date
startDate = InputBox("Enter start date (mm/dd/yyyy):")
' Prompt user to enter end date
endDate = InputBox("Enter end date (mm/dd/yyyy):")
Set rst = CurrentDb.OpenRecordset("SELECT * FROM CustomerT WHERE ExpiryDate >= #" & startDate & "# AND ExpiryDate <= #" & endDate & "#")
rst.MoveFirst
Do Until rst.EOF Or rst.BOF
rst.Edit
rst("ToPrint") = True
rst.Update
rst.MoveNext
Loop
DoCmd.OpenReport "2DateReports", acViewPreview, , , acNormal
rst.MoveFirst
Do Until rst.EOF Or rst.BOF
rst.Edit
rst("ToPrint") = False
rst.Update
rst.MoveNext
Loop
End Sub
Most likely a timing issue - perhaps the report hasn't finished printing.
Try this:
DoCmd.OpenReport "2DateReports", acViewPreview, , , acNormal
DoEvents
Stop ' Press F5 to continue. To be removed after test.
Related
I have form (Arzyabi_Tamin_Konande_da) that opens in dialog form by this code:
Me.Form.Dirty = False
Dim ASK As Integer
Dim rs As DAO.Recordset
Set rs = Me.RecordsetClone
With rs
.MoveFirst
Do While Not rs.EOF
.Edit
If (!Tahvil_Tmp = True) * (!Az_Tankhah = False) Then
If DLookup("[Saff_Arzyabi_2]", "Arzyabi_Tamin_Konande_sh", _
"val([Cod_Tamin_Konande]) = '" & !Cod_Tamin_Konande & "'") = True Then
DoCmd.OpenForm "Arzyabi_Tamin_Konande_da", acNormal, , "[Cod_Tamin_Konande]=" & !Cod_Tamin_Konande, , acdialog
End If
.Update
.MoveNext
Loop
end with
but when the form gets open I cant change records, all the record get locked
other wise if I open the form in acWindowNormal mode every thing is right
I try to create another query for the loop I use but it's not working.
But why are you using a edit command in the loop that opens that form?
You have this:
With rs
.MoveFirst
Do While Not rs.EOF
.Edit <------ WHY? This does nothing?????? explain!!!
If (!Tahvil_Tmp = True) * (!Az_Tankhah = False) Then
If DLookup("[Saff_Arzyabi_2]", "Arzyabi_Tamin_Konande_sh", _
"val([Cod_Tamin_Konande]) = '" & !Cod_Tamin_Konande & "'") = True Then
DoCmd.OpenForm "Arzyabi_Tamin_Konande_da", acNormal, , "[Cod_Tamin_Konande]=" & !Cod_Tamin_Konande, , acDialog
End If
.Update
.MoveNext
Loop
End With
So, what does that .Edit command do? All it REALLY does is wind up locking the reocrd, but then that does ZERO value, does nothing of value, and you don't do any edits??? So, why? What is the reason for that .edit command? (except to lock the reocrd!!!).
Remove that edit command, you are launching some form, and that form should be able to do whatever it likes to do!!!!
A wild good guess in the dark??
That code should be this:
With rs
.MoveFirst
Do While Not rs.EOF
If (!Tahvil_Tmp = True) * (!Az_Tankhah = False) Then
If DLookup("[Saff_Arzyabi_2]", "Arzyabi_Tamin_Konande_sh", _
"val([Cod_Tamin_Konande]) = '" & !Cod_Tamin_Konande & "'") = True Then
DoCmd.OpenForm "Arzyabi_Tamin_Konande_da", acNormal, , "[Cod_Tamin_Konande]=" & !Cod_Tamin_Konande, , acDialog
End If
.MoveNext
Loop
End With
me.Refresh <---- show any update dated in our form after dialog
prompts are done.
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
The code below generates PDF reports for supervisors who have employees expiring between StartDate and StopDate fields on a form. I am getting multiple reports for supervisors who do not have employees expiring in that range, blank reports essentially. The code also puts out the correct reports that have data.
How can I prevent OutputTo from saving the blank reports?
SQL for reference query (qry_Distinct_Supervisors):
PARAMETERS StartDate DateTime, StopDate DateTime;
SELECT DISTINCT qry_Base_For_All.Supervisor, qry_Base_For_All.LID, qry_Base_For_All._Status, qry_Base_For_All.LASTNAME, qry_Base_For_All.FIRSTNAME, qry_Base_For_All.[End Date]
FROM qry_Base_For_All
WHERE (((qry_Base_For_All.Supervisor) Is Not Null) AND ((qry_Base_For_All.LASTNAME) Is Not Null) AND ((qry_Base_For_All.[End Date]) Between [StartDate] And [StopDate]));
SQL for Report
SELECT DISTINCT qry_Base_For_All.L_ID, qry_Base_For_All.LASTNAME, qry_Base_For_All.FIRSTNAME, qry_Base_For_All.P_ID, qry_Base_For_All.Company, qry_Base_For_All.[End Date], qry_Base_For_All.Supervisor, qry_Base_For_All.Title
FROM qry_Base_For_All
WHERE (((qry_Base_For_All.[End Date]) Between [Forms]![frm_Bldg_Access]![StartDate] And [Forms]![frm_Bldg_Access]![StopDate]) AND ((qry_Base_For_All.Title) Like "*" & "outsource" & "*"));
VBA to save reports
Private Sub btn_Print_Report_Click()
'split report into PDFs named after supervisor and open a separate email with each report attached
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim MyFileName As String
Dim mypath As String
Dim temp As String
Dim qry As QueryDef
Dim StartDate As DAO.Parameter
Dim StopDate As DAO.Parameter
Set db = CurrentDb()
Set qry = db.QueryDefs("qry_Distinct_Supervisors")
mypath = "C:\Users\cw52450\Desktop\Test Exports\"
qry.Parameters("StartDate").Value = Forms!frm_Bldg_Access!StartDate
qry.Parameters("StopDate").Value = Forms!frm_Bldg_Access!StopDate
Set rs = qry.OpenRecordset(dbOpenSnapshot)
'populate rs
If Not (rs.EOF And rs.BOF) Then
rs.MoveLast
rs.MoveFirst
'start report generation loop
'Currenlty outputting blank reports as well as needed ones
Do While Not rs.EOF
temp = rs("Supervisor")
MyFileName = rs("Supervisor") & Format(Date, ", mmm yyyy") & ".PDF"
DoCmd.OpenReport "rpt_Expiring_Access", acViewReport, , "[Supervisor]='" & temp & "'"
DoCmd.OutputTo acOutputReport, "", acFormatPDF, mypath & MyFileName
DoCmd.Close acReport, "rpt_Expiring_Access"
DoEvents
rs.MoveNext
Loop
Else
MsgBox "There are no records in the recordset."
End If
MsgBox "Report generation complete."
Set rs = Nothing
Set db = Nothing
Set qry = Nothing
End Sub
I keep getting an error when I run this code.
Sub SendEmailMaturing()
Dim rs As DAO.Recordset
Dim db As Database
Dim strSQL As String
Set db = CurrentDb
strSQL = "SELECT * FROM qRespCodeEmail"
Set rs = CurrentDb.OpenRecordset(strSQL)
If Not rs.BOF And Not rs.EOF Then
rs.MoveFirst
Do While Not rs.EOF
'Debug.Print rs.Fields("RMName")
DoCmd.OpenReport "Maturing Loans in 90", acViewPreview, , "RespName = " & rs!RMName
DoCmd.SendObject acSendReport, "Maturing Loans in 90", acFormatPDF, rs!Email, , , "Maturing Loans", "Kindly take a look and send me an update on the status of matured loans.", True
DoCmd.Close acReport, "Maturing Loans in 90", acSaveNo
rs.MoveNext
Loop
End If
rs.Close
Set rs = Nothing
End Sub
If you are filtering on a text field, use apostrophe delimiters for parameter:
DoCmd.OpenReport "Maturing Loans in 90", acViewPreview, , "RespName = '" & rs!RMName & "'"
Use # for date/time fields, nothing for number type.
Could reduce amount of data pulled by including just necessary fields in SQL statement. Appears you need only RMName and Email.
I've got an Access application that uses a UID for each record, however it does not match up to the record order in SQL. (i.e. my UID of 12845 corresponds to record number 12834 in Access)
I have a search box that I've created that is supposed to search the Access DB and pull up the record that it finds the matching UID, however, the way I've written the code is that it's going to the Record number that matches the UID (so it will goto record number 12845 instead of record 12834 using UID 12845).
I've been sitting on this for a few days and I can't find a way around it. Searching the internet has not proved helpful. IF anyone has an idea for how one can match a string and goto THAT record vs trying to parse the record info myself, then that would be great.
The following is an example of the code I am using. It takes a date string and looks for the string in the records, gets the UID, and then tries to goto the corresponding record:
Private Sub FindBarCodeDate_Click()
Dim Barcode As String
Dim EndDate As String
If IsNull(BarcodeSearch.Value) Then
If IsNull(DateSearch.Value) Then
GoTo Done
Else
EndDate = DateSearch.Value
End If
Else
If IsNull(DateSearch.Value) Then
Barcode = BarcodeSearch.Value
Else
Barcode = BarcodeSearch.Value
EndDate = DateSearch.Value
End If
End If
Dim rs As New ADODB.Recordset
Dim strSql As String
Dim TSD As String
If Barcode <> "" Then
If EndDate <> "" Then
strSql = "SELECT [TSD ID] FROM dbo_barAdultCollectionData WHERE Barcode = '" & Barcode & "' AND [End Date] = '" & EndDate & "'"
On Error GoTo Done
rs.Open strSql, CurrentProject.Connection
TSD = rs.Fields.Item(0)
rs.Close
DoCmd.FindRecord TSD, acEntire, False, acSearchAll, False, acAll, True
Set rs = Nothing
Else
strSql = "SELECT [TSD ID] FROM dbo_barAdultCollectionData WHERE Barcode = '" & Barcode & "'"
On Error GoTo Done
rs.Open strSql, CurrentProject.Connection
TSD = rs.Fields.Item(0)
rs.Close
DoCmd.FindRecord FindWhat:=TSD, Match:=acEntire, MatchCase:=False, Search:=acSearchAll, SearchAsFormatted:=False, OnlyCurrentField:=acAll, FindFirst:=True
Set rs = Nothing
End If
ElseIf Barcode = "" Then
If EndDate <> "" Then
strSql = "SELECT [TSD ID] FROM dbo_barAdultCollectionData WHERE [End Date] = '" & EndDate & "'"
On Error GoTo Done
rs.Open strSql, CurrentProject.Connection
TSD = rs.Fields.Item(0)
rs.Close
DoCmd.FindRecord FindWhat:=TSD, Match:=acEntire, MatchCase:=False, Search:=acSearchAll, SearchAsFormatted:=False, OnlyCurrentField:=acAll, FindFirst:=True
Set rs = Nothing
End If
Else
Done:
SearchError.Caption = "Invalid Search Term!"
End If
End Sub
Thanks!
Don't use DoCmd.FindRecord. Use the technique shown in the second example of Form.RecordsetClone, e.g.
Dim rst As DAO.Recordset
Set rst = Me.RecordsetClone
rst.FindFirst "yourUIDcolumn = '" & TSD & "'"
If rst.NoMatch Then
' This should not happen
MsgBox "Record not found", vbCritical, "Panic!"
Else
' Set current record in form to found record
Me.Bookmark = rst.Bookmark
End If
rst.Close
First, try adding -11 to the UID:
TSD = CStr(Val(rs.Fields.Item(0).Value) - 11)
Also, you need to format your date values as string expressions:
EndDate = Format(DateSearch.Value, "yyyy\/mm\/dd")
and then:
strSql = "SELECT [TSD ID] FROM dbo_barAdultCollectionData WHERE [End Date] = #" & EndDate & "#"