Multiple Reports for Listbox

[gm6243 via AccessMonster.com]

Dear All,

I am reposting this as I have not got any response to my earlier posting. Can
someone please help

I have a form with a listbox lboemployee which has a record source
tblEmployee. I have a report Employee Sales for the Month.
I want to print individual reports for each of the employee as a separate
report when cmdprintreports is clicked.
I want to avoid printing one report at a time.

I have been some what successful with the following code:
The code works until there is a employee who has no data in the report

I get the pop up for NO DATA and it stops printing reports for the other
employees.

Can someone please help in completing the code so that if there is no data
for one employee, it will still print the report for all subsequent employees
in the list.

Thank You

The Code is a below:

Private Sub Command62_Click()
Const cInvalidDateError As String = "You have entered an invalid date."
Dim intItem As Integer
Dim lbo As ListBox
Dim strWhere As String
Dim blRet As Boolean


Set lbo = Me.Lbopkagt
On Error GoTo Err_Handler

strWhere = "1=1"

If IsNull(Me.manager) Then
MsgBox "Please Select A Manager and Retry", vbExclamation, "Invalid
Selection"
Cancel = True
Else

If Not IsNull(Me.manager) Then
strWhere = strWhere & " AND " & "[manager] = '" & Me.manager & "'"
End If

If Not IsNull(Me.Accession) Then
strWhere = strWhere & " AND " & "[sgmnt] = '" & Me.Accession & "'"
End If

If IsDate(Me.txtEndDate) Then
strWhere = strWhere & " AND " & "[reportdate] = " & GetDateFilter((Me.
txtEndDate) + 1)
ElseIf Nz(Me.txtEndDate) <> "" Then
strError = cInvalidDateError
End If
End If

For intItem = 0 To lbo.ListCount - 1
Debug.Print lbo.ItemData(intItem)
strWhere = strWhere & " AND " & "Repname=""" & lbo.ItemData(intItem)
& """"
DoCmd.OpenReport "Daily Count By Sales Rep" _
, , , strWhere

Next


Exit_Handler:
Exit Sub

Err_Handler:

Select Case Err.Number

Case 2501

Case Else
MsgBox Err.Description, vbExclamation, "Error No: " & Err.Number

End Select

Resume Exit_Handler

End Sub

Thank You

 

[Steve Sanford]

There are a couple of things I noticed that needs correcting. The click event
of a button cannot be canceled. And the loop for the list box kept adding
each rep's name to strWhere.

You didn't say anything about code in the report, but you need to have this
in the "On No Data" event of the report:

'------------------
Private Sub Report_NoData(Cancel As Integer)
Cancel = True
End Sub
'------------------


Here is the code I modified. It is ***UNTESTED*** ......

'------------------
Private Sub Command62_Click()
Const cInvalidDateError As String = "You have entered an invalid date."
Dim intItem As Integer
Dim lbo As ListBox
Dim strWhere As String
Dim strCriteria As String
Dim blRet As Boolean


Set lbo = Me.Lbopkagt
On Error GoTo Err_Handler

strCriteria = "1=1"

If IsNull(Me.manager) Then
MsgBox "Please Select A Manager and Retry", vbExclamation, "Invalid
Selection"
Exit Sub
'set the focus to the manager control
' Me.manager.SetFocus
Else
strCriteria = strCriteria & " AND [manager] = '" & Me.manager & "'"
End If

If Not IsNull(Me.Accession) Then
strCriteria = strCriteria & " AND [sgmnt] = '" & Me.Accession & "'"
End If

If IsDate(CDate(Me.txtEndDate)) Then
strCriteria = strCriteria & " AND [reportdate] = " &
GetDateFilter((Me.txtEndDate) + 1)
ElseIf Nz(Me.txtEndDate) <> "" Then
' this doesn't do anything
strError = cInvalidDateError
'say the error and goto the date control
' MsgBox cInvalidDateError
' Exit Sub
' Me.txtEndDate.SetFocus
End If

'loop thru each list box row and print report
For intItem = 0 To lbo.ListCount - 1
Debug.Print lbo.ItemData(intItem)
strWhere = strCriteria & " AND Repname = """ & lbo.ItemData(intItem) &
""""
DoCmd.OpenReport "Daily Count By Sales Rep", , , strWhere
' Debug.Print strWhere
Next


Exit_Handler:
Exit Sub

Err_Handler:

Select Case Err.Number
Case 2501
Err.Clear
Resume Next
Case Else
MsgBox Err.Description, vbExclamation, "Error No: " & Err.Number
End Select

Resume Exit_Handler

End Sub
'------------------


HTH
--
Steve S
--------------------------------
"Veni, Vidi, Velcro"
(I came; I saw; I stuck around.)

Dear All,

I am reposting this as I have not got any response to my earlier posting. Can
someone please help

I have a form with a listbox lboemployee which has a record source
tblEmployee. I have a report Employee Sales for the Month.
I want to print individual reports for each of the employee as a separate
report when cmdprintreports is clicked.
I want to avoid printing one report at a time.

I have been some what successful with the following code:
The code works until there is a employee who has no data in the report

I get the pop up for NO DATA and it stops printing reports for the other
employees.

Can someone please help in completing the code so that if there is no data
for one employee, it will still print the report for all subsequent employees
in the list.

Thank You

The Code is a below:

Private Sub Command62_Click()
Const cInvalidDateError As String = "You have entered an invalid date."
Dim intItem As Integer
Dim lbo As ListBox
Dim strWhere As String
Dim blRet As Boolean


Set lbo = Me.Lbopkagt
On Error GoTo Err_Handler

strWhere = "1=1"

If IsNull(Me.manager) Then
MsgBox "Please Select A Manager and Retry", vbExclamation, "Invalid
Selection"
Cancel = True
Else

If Not IsNull(Me.manager) Then
strWhere = strWhere & " AND " & "[manager] = '" & Me.manager & "'"
End If

If Not IsNull(Me.Accession) Then
strWhere = strWhere & " AND " & "[sgmnt] = '" & Me.Accession & "'"
End If

If IsDate(Me.txtEndDate) Then
strWhere = strWhere & " AND " & "[reportdate] = " & GetDateFilter((Me.
txtEndDate) + 1)
ElseIf Nz(Me.txtEndDate) <> "" Then
strError = cInvalidDateError
End If
End If

For intItem = 0 To lbo.ListCount - 1
Debug.Print lbo.ItemData(intItem)
strWhere = strWhere & " AND " & "Repname=""" & lbo.ItemData(intItem)
& """"
DoCmd.OpenReport "Daily Count By Sales Rep" _
, , , strWhere

Next


Exit_Handler:
Exit Sub

Err_Handler:

Select Case Err.Number

Case 2501

Case Else
MsgBox Err.Description, vbExclamation, "Error No: " & Err.Number

End Select

Resume Exit_Handler

End Sub

Thank You

 

[gm6243 via AccessMonster.com]

Hi Steve,

You are the best. This code worked like a miracle. Great Help. Absolutely
what I needed.
Thanks

Gmen.

There are a couple of things I noticed that needs correcting. The click event
of a button cannot be canceled. And the loop for the list box kept adding
each rep's name to strWhere.

You didn't say anything about code in the report, but you need to have this
in the "On No Data" event of the report:

'------------------
Private Sub Report_NoData(Cancel As Integer)
Cancel = True
End Sub
'------------------

Here is the code I modified. It is ***UNTESTED*** ......

'------------------
Private Sub Command62_Click()
Const cInvalidDateError As String = "You have entered an invalid date."
Dim intItem As Integer
Dim lbo As ListBox
Dim strWhere As String
Dim strCriteria As String
Dim blRet As Boolean

Set lbo = Me.Lbopkagt
On Error GoTo Err_Handler

strCriteria = "1=1"

If IsNull(Me.manager) Then
MsgBox "Please Select A Manager and Retry", vbExclamation, "Invalid
Selection"
Exit Sub
'set the focus to the manager control
' Me.manager.SetFocus
Else
strCriteria = strCriteria & " AND [manager] = '" & Me.manager & "'"
End If

If Not IsNull(Me.Accession) Then
strCriteria = strCriteria & " AND [sgmnt] = '" & Me.Accession & "'"
End If

If IsDate(CDate(Me.txtEndDate)) Then
strCriteria = strCriteria & " AND [reportdate] = " &
GetDateFilter((Me.txtEndDate) + 1)
ElseIf Nz(Me.txtEndDate) <> "" Then
' this doesn't do anything
strError = cInvalidDateError
'say the error and goto the date control
' MsgBox cInvalidDateError
' Exit Sub
' Me.txtEndDate.SetFocus
End If

'loop thru each list box row and print report
For intItem = 0 To lbo.ListCount - 1
Debug.Print lbo.ItemData(intItem)
strWhere = strCriteria & " AND Repname = """ & lbo.ItemData(intItem) &
""""
DoCmd.OpenReport "Daily Count By Sales Rep", , , strWhere
' Debug.Print strWhere
Next

Exit_Handler:
Exit Sub

Err_Handler:

Select Case Err.Number
Case 2501
Err.Clear
Resume Next
Case Else
MsgBox Err.Description, vbExclamation, "Error No: " & Err.Number
End Select

Resume Exit_Handler

End Sub
'------------------

HTH

Dear All,

[quoted text clipped - 85 lines]

Thank You

 

[gm6243 via AccessMonster.com]

Hi Steve,

Thanks for the code and though it was untested, it worked perfect.

I have one thing which I have done to most of my reports which is automated
them to directly print to pdf using Stephen Lebans PDF codes.

I have added the following for to the code after the docmd..

For intItem = 0 To lbo.ListCount - 1
' Debug.Print lbo.ItemData(intItem)
strWhere = strCriteria & " AND Repname = """ & lbo.ItemData(intItem) &
""""
DoCmd.OpenReport "Daily Count By Sales Rep", acIcon, , strWhere,
acHidden
blRet = ConvertReportToPDF("Daily Count By Sales Rep", vbNullString, _
"L:\GP Reports\Sales Rep Reports\" _
& Me.repname & "-" & "DCR -" & Format(([Forms]![PDFManagertest]!
[txtEndDate]), "yyyymmdd") & ".pdf", False, False, 0, "", "", 0, 0)
DoCmd.Close acReport, "Daily Count By Sales Rep"

----
Here the repname is the items in the listbox. By automating this I want the
report to be saved as a pdf file with the repname-DCR - 20081031

using the above as it is, it saves the pdf file as DCR - 20081031. The next
report gets over written to this same file, ultimately saving the last
generated report.

Is there any way I can include the repname as a prefix to the output.

Thanks and appreciate you help.

Gmen

There are a couple of things I noticed that needs correcting. The click event
of a button cannot be canceled. And the loop for the list box kept adding
each rep's name to strWhere.

You didn't say anything about code in the report, but you need to have this
in the "On No Data" event of the report:

'------------------
Private Sub Report_NoData(Cancel As Integer)
Cancel = True
End Sub
'------------------

Here is the code I modified. It is ***UNTESTED*** ......

'------------------
Private Sub Command62_Click()
Const cInvalidDateError As String = "You have entered an invalid date."
Dim intItem As Integer
Dim lbo As ListBox
Dim strWhere As String
Dim strCriteria As String
Dim blRet As Boolean

Set lbo = Me.Lbopkagt
On Error GoTo Err_Handler

strCriteria = "1=1"

If IsNull(Me.manager) Then
MsgBox "Please Select A Manager and Retry", vbExclamation, "Invalid
Selection"
Exit Sub
'set the focus to the manager control
' Me.manager.SetFocus
Else
strCriteria = strCriteria & " AND [manager] = '" & Me.manager & "'"
End If

If Not IsNull(Me.Accession) Then
strCriteria = strCriteria & " AND [sgmnt] = '" & Me.Accession & "'"
End If

If IsDate(CDate(Me.txtEndDate)) Then
strCriteria = strCriteria & " AND [reportdate] = " &
GetDateFilter((Me.txtEndDate) + 1)
ElseIf Nz(Me.txtEndDate) <> "" Then
' this doesn't do anything
strError = cInvalidDateError
'say the error and goto the date control
' MsgBox cInvalidDateError
' Exit Sub
' Me.txtEndDate.SetFocus
End If

'loop thru each list box row and print report
For intItem = 0 To lbo.ListCount - 1
Debug.Print lbo.ItemData(intItem)
strWhere = strCriteria & " AND Repname = """ & lbo.ItemData(intItem) &
""""
DoCmd.OpenReport "Daily Count By Sales Rep", , , strWhere
' Debug.Print strWhere
Next

Exit_Handler:
Exit Sub

Err_Handler:

Select Case Err.Number
Case 2501
Err.Clear
Resume Next
Case Else
MsgBox Err.Description, vbExclamation, "Error No: " & Err.Number
End Select

Resume Exit_Handler

End Sub
'------------------

HTH

Dear All,

[quoted text clipped - 85 lines]

Thank You

 

[Steve Sanford]

I think this might be what you want. There might still be a few issues - I
don't know what will happen if a rep's name is like O'Brian or O'Hare.

To remove the single quote, you could try something like this:

strRep = Replace(lbo.ItemData(intItem), "'", "")

Expanded, it looks like this -> " ' ", " ")


The date now is required, so the code will quit if there is not a date
entered. Note the PDF name will be different than the date parameter for the
criteria because you add 1 day to the EndDate. I also don't know what the
function GetDateFilter() does. If you want the PDF file name to match the
date criteria,you will have to change this line in the code:

strEndDate = Format(Me.[txtEndDate], "yyyymmdd")

to something like:

strEndDate = Format(GetDateFilter((Me.txtEndDate) + 1, "yyyymmdd")


TIP: the top two lines of *every* module should be:

Option Compare Database
Option Explicit


Remember.......THIS CODE IS ***UNTESTED*** ......

'---------------code beg------------------
Option Compare Database
Option Explicit

Private Sub Command62_Click()
Const cInvalidDateError As String = "You have entered an invalid date."
' Dim strError As String
Dim intItem As Integer
Dim lbo As ListBox
Dim strWhere As String
Dim strCriteria As String
Dim blPrintedOK As Boolean
Dim blRet As Boolean
Dim strRep As String
Dim strSavePath As String
Dim stRptName As String
Dim strOutputPDFname As String
Dim strEndDate As String


On Error GoTo Err_Handler

'------ set defaults -------
Set lbo = Me.Lbopkagt
strSavePath = "L:\GP Reports\Sales Rep Reports\"
stRptName = "Daily Count By Sales Rep"
strCriteria = "1=1"
blPrintedOK = True
'---------------------------

If IsNull(Me.manager) Then
MsgBox "Please Select A Manager and Retry", vbExclamation, "Invalid
Selection"
'set the focus to the manager control
Me.manager.SetFocus
Exit Sub
Else
strCriteria = strCriteria & " AND [manager] = '" & Me.manager & "'"
End If

If Not IsNull(Me.Accession) Then
strCriteria = strCriteria & " AND [sgmnt] = '" & Me.Accession & "'"
End If

' VALID endate Required!!
If IsDate(CDate(Me.txtEndDate)) Then
strCriteria = strCriteria & " AND [reportdate] = " &
GetDateFilter(Me.txtEndDate + 1)
' this is for the CreatePDF output file name
strEndDate = Format(Me.[txtEndDate], "yyyymmdd")
ElseIf Nz(Me.txtEndDate) <> "" Then
' strError = cInvalidDateError
' report the error, then goto the date control
MsgBox cInvalidDateError
'set the focus to [txtEndDate] control
Me.txtEndDate.SetFocus
Exit Sub
End If

'loop thru each list box row and print report
For intItem = 0 To lbo.ListCount - 1
' Debug.Print lbo.ItemData(intItem)
strRep = lbo.ItemData(intItem)
strWhere = strCriteria & " AND Repname = """ & strRep & """"
DoCmd.OpenReport stRptName, , , strWhere
' Debug.Print strWhere

'don't want to try and create a PDF if the report has no data
' if the report printed, then create PDF file
If blPrintedOK Then
'CreatePDF output file name
strOutputPDFname = strSavePath & strRep & "-DCR - " & strEndDate &
".pdf"
' Debug.Print strOutputPDFname

blRet = ConvertReportToPDF(stRptName, vbNullString,
strOutputPDFname, False, False)
DoCmd.Close acReport, stRptName
Else
' reset NoData switch - see error handler
blPrintedOK = True
End If
'clear rep name - ready for next rep
strRep = ""
Next

Exit_Handler:
Exit Sub

Err_Handler:

Select Case Err.Number
Case 2501
' if rpt no data, set error flag
blPrintedOK = False
Err.Clear
Resume Next
Case Else
MsgBox Err.Description, vbExclamation, "Error No: " & Err.Number
End Select

Resume Exit_Handler

End Sub
'---------------code end------------------


HTH
--
Steve S
--------------------------------
"Veni, Vidi, Velcro"
(I came; I saw; I stuck around.)

Hi Steve,

Thanks for the code and though it was untested, it worked perfect.

I have one thing which I have done to most of my reports which is automated
them to directly print to pdf using Stephen Lebans PDF codes.

I have added the following for to the code after the docmd..

For intItem = 0 To lbo.ListCount - 1
' Debug.Print lbo.ItemData(intItem)
strWhere = strCriteria & " AND Repname = """ & lbo.ItemData(intItem) &
""""
DoCmd.OpenReport "Daily Count By Sales Rep", acIcon, , strWhere,
acHidden
blRet = ConvertReportToPDF("Daily Count By Sales Rep", vbNullString, _
"L:\GP Reports\Sales Rep Reports\" _
& Me.repname & "-" & "DCR -" & Format(([Forms]![PDFManagertest]!
[txtEndDate]), "yyyymmdd") & ".pdf", False, False, 0, "", "", 0, 0)
DoCmd.Close acReport, "Daily Count By Sales Rep"

----
Here the repname is the items in the listbox. By automating this I want the
report to be saved as a pdf file with the repname-DCR - 20081031

using the above as it is, it saves the pdf file as DCR - 20081031. The next
report gets over written to this same file, ultimately saving the last
generated report.

Is there any way I can include the repname as a prefix to the output.

Thanks and appreciate you help.

Gmen

 

[gm6243 via AccessMonster.com]

Hi Steve,

Thanks for the updated code. When I run this new code, I get a dialogbox for
File Save, with the default report name instead of outputting the report as
Repname-DCR-20081029. Seems there is something missing.
thanks for pointing the name issue with apostrophe, I will change it in all
my modules.
As regards date, our system generates a sales text file after midnight for
the previous day and the report date is the current date though the data is
for the previous day. For the benefit of the users, I have used the real
sales date on the form and hence add the 1 to the form date to get the report
date. The date field on the form is a compulsory field.

Please help.

I think this might be what you want. There might still be a few issues - I
don't know what will happen if a rep's name is like O'Brian or O'Hare.

To remove the single quote, you could try something like this:

strRep = Replace(lbo.ItemData(intItem), "'", "")

Expanded, it looks like this -> " ' ", " ")

The date now is required, so the code will quit if there is not a date
entered. Note the PDF name will be different than the date parameter for the
criteria because you add 1 day to the EndDate. I also don't know what the
function GetDateFilter() does. If you want the PDF file name to match the
date criteria,you will have to change this line in the code:

strEndDate = Format(Me.[txtEndDate], "yyyymmdd")

to something like:

strEndDate = Format(GetDateFilter((Me.txtEndDate) + 1, "yyyymmdd")

TIP: the top two lines of *every* module should be:

Option Compare Database
Option Explicit

Remember.......THIS CODE IS ***UNTESTED*** ......

'---------------code beg------------------
Option Compare Database
Option Explicit

Private Sub Command62_Click()
Const cInvalidDateError As String = "You have entered an invalid date."
' Dim strError As String
Dim intItem As Integer
Dim lbo As ListBox
Dim strWhere As String
Dim strCriteria As String
Dim blPrintedOK As Boolean
Dim blRet As Boolean
Dim strRep As String
Dim strSavePath As String
Dim stRptName As String
Dim strOutputPDFname As String
Dim strEndDate As String

On Error GoTo Err_Handler

'------ set defaults -------
Set lbo = Me.Lbopkagt
strSavePath = "L:\GP Reports\Sales Rep Reports\"
stRptName = "Daily Count By Sales Rep"
strCriteria = "1=1"
blPrintedOK = True
'---------------------------

If IsNull(Me.manager) Then
MsgBox "Please Select A Manager and Retry", vbExclamation, "Invalid
Selection"
'set the focus to the manager control
Me.manager.SetFocus
Exit Sub
Else
strCriteria = strCriteria & " AND [manager] = '" & Me.manager & "'"
End If

If Not IsNull(Me.Accession) Then
strCriteria = strCriteria & " AND [sgmnt] = '" & Me.Accession & "'"
End If

' VALID endate Required!!
If IsDate(CDate(Me.txtEndDate)) Then
strCriteria = strCriteria & " AND [reportdate] = " &
GetDateFilter(Me.txtEndDate + 1)
' this is for the CreatePDF output file name
strEndDate = Format(Me.[txtEndDate], "yyyymmdd")
ElseIf Nz(Me.txtEndDate) <> "" Then
' strError = cInvalidDateError
' report the error, then goto the date control
MsgBox cInvalidDateError
'set the focus to [txtEndDate] control
Me.txtEndDate.SetFocus
Exit Sub
End If

'loop thru each list box row and print report
For intItem = 0 To lbo.ListCount - 1
' Debug.Print lbo.ItemData(intItem)
strRep = lbo.ItemData(intItem)
strWhere = strCriteria & " AND Repname = """ & strRep & """"
DoCmd.OpenReport stRptName, , , strWhere
' Debug.Print strWhere

'don't want to try and create a PDF if the report has no data
' if the report printed, then create PDF file
If blPrintedOK Then
'CreatePDF output file name
strOutputPDFname = strSavePath & strRep & "-DCR - " & strEndDate &
".pdf"
' Debug.Print strOutputPDFname

blRet = ConvertReportToPDF(stRptName, vbNullString,
strOutputPDFname, False, False)
DoCmd.Close acReport, stRptName
Else
' reset NoData switch - see error handler
blPrintedOK = True
End If
'clear rep name - ready for next rep
strRep = ""
Next

Exit_Handler:
Exit Sub

Err_Handler:

Select Case Err.Number
Case 2501
' if rpt no data, set error flag
blPrintedOK = False
Err.Clear
Resume Next
Case Else
MsgBox Err.Description, vbExclamation, "Error No: " & Err.Number
End Select

Resume Exit_Handler

End Sub
'---------------code end------------------

HTH

Hi Steve,

[quoted text clipped - 30 lines]

Gmen

 

[Steve Sanford]

Try changing this line

blRet = ConvertReportToPDF(stRptName, vbNullString, strOutputPDFname, False,
False)

to

blRet = ConvertReportToPDF(stRptName, vbNullString, strOutputPDFname, False,
False, 0, "", "", 0, 0)

note: should be on one line!

I'll look into it more tonight.


--
Steve S
--------------------------------
"Veni, Vidi, Velcro"
(I came; I saw; I stuck around.)

Hi Steve,

Thanks for the updated code. When I run this new code, I get a dialogbox for
File Save, with the default report name instead of outputting the report as
Repname-DCR-20081029. Seems there is something missing.
thanks for pointing the name issue with apostrophe, I will change it in all
my modules.
As regards date, our system generates a sales text file after midnight for
the previous day and the report date is the current date though the data is
for the previous day. For the benefit of the users, I have used the real
sales date on the form and hence add the 1 to the form date to get the report
date. The date field on the form is a compulsory field.

Please help.

I think this might be what you want. There might still be a few issues - I
don't know what will happen if a rep's name is like O'Brian or O'Hare.

To remove the single quote, you could try something like this:

strRep = Replace(lbo.ItemData(intItem), "'", "")

Expanded, it looks like this -> " ' ", " ")

The date now is required, so the code will quit if there is not a date
entered. Note the PDF name will be different than the date parameter for the
criteria because you add 1 day to the EndDate. I also don't know what the
function GetDateFilter() does. If you want the PDF file name to match the
date criteria,you will have to change this line in the code:

strEndDate = Format(Me.[txtEndDate], "yyyymmdd")

to something like:

strEndDate = Format(GetDateFilter((Me.txtEndDate) + 1, "yyyymmdd")

TIP: the top two lines of *every* module should be:

Option Compare Database
Option Explicit

Remember.......THIS CODE IS ***UNTESTED*** ......

'---------------code beg------------------
Option Compare Database
Option Explicit

Private Sub Command62_Click()
Const cInvalidDateError As String = "You have entered an invalid date."
' Dim strError As String
Dim intItem As Integer
Dim lbo As ListBox
Dim strWhere As String
Dim strCriteria As String
Dim blPrintedOK As Boolean
Dim blRet As Boolean
Dim strRep As String
Dim strSavePath As String
Dim stRptName As String
Dim strOutputPDFname As String
Dim strEndDate As String

On Error GoTo Err_Handler

'------ set defaults -------
Set lbo = Me.Lbopkagt
strSavePath = "L:\GP Reports\Sales Rep Reports\"
stRptName = "Daily Count By Sales Rep"
strCriteria = "1=1"
blPrintedOK = True
'---------------------------

If IsNull(Me.manager) Then
MsgBox "Please Select A Manager and Retry", vbExclamation, "Invalid
Selection"
'set the focus to the manager control
Me.manager.SetFocus
Exit Sub
Else
strCriteria = strCriteria & " AND [manager] = '" & Me.manager & "'"
End If

If Not IsNull(Me.Accession) Then
strCriteria = strCriteria & " AND [sgmnt] = '" & Me.Accession & "'"
End If

' VALID endate Required!!
If IsDate(CDate(Me.txtEndDate)) Then
strCriteria = strCriteria & " AND [reportdate] = " &
GetDateFilter(Me.txtEndDate + 1)
' this is for the CreatePDF output file name
strEndDate = Format(Me.[txtEndDate], "yyyymmdd")
ElseIf Nz(Me.txtEndDate) <> "" Then
' strError = cInvalidDateError
' report the error, then goto the date control
MsgBox cInvalidDateError
'set the focus to [txtEndDate] control
Me.txtEndDate.SetFocus
Exit Sub
End If

'loop thru each list box row and print report
For intItem = 0 To lbo.ListCount - 1
' Debug.Print lbo.ItemData(intItem)
strRep = lbo.ItemData(intItem)
strWhere = strCriteria & " AND Repname = """ & strRep & """"
DoCmd.OpenReport stRptName, , , strWhere
' Debug.Print strWhere

'don't want to try and create a PDF if the report has no data
' if the report printed, then create PDF file
If blPrintedOK Then
'CreatePDF output file name
strOutputPDFname = strSavePath & strRep & "-DCR - " & strEndDate &
".pdf"
' Debug.Print strOutputPDFname

blRet = ConvertReportToPDF(stRptName, vbNullString,
strOutputPDFname, False, False)
DoCmd.Close acReport, stRptName
Else
' reset NoData switch - see error handler
blPrintedOK = True
End If
'clear rep name - ready for next rep
strRep = ""
Next

Exit_Handler:
Exit Sub

Err_Handler:

Select Case Err.Number
Case 2501
' if rpt no data, set error flag
blPrintedOK = False
Err.Clear
Resume Next
Case Else
MsgBox Err.Description, vbExclamation, "Error No: " & Err.Number
End Select

Resume Exit_Handler

End Sub
'---------------code end------------------

HTH

Hi Steve,

[quoted text clipped - 30 lines]

Gmen

 

[gm6243 via AccessMonster.com]

Hi Steve,


Thank you.

There is no change to the situation. It still brings up the File Save as
dialogbox with the default stRptName, prompting to save

Will recheck tonight for your comments and advice.

Thank you.

Gmen

Try changing this line

blRet = ConvertReportToPDF(stRptName, vbNullString, strOutputPDFname, False,
False)

to

blRet = ConvertReportToPDF(stRptName, vbNullString, strOutputPDFname, False,
False, 0, "", "", 0, 0)

note: should be on one line!

I'll look into it more tonight.

Hi Steve,

[quoted text clipped - 150 lines]

 

[gm6243 via AccessMonster.com]

Hi Steve,

I am not sure if you are still watching this posting.

But if you are, I picked up a couple of your lines and added to the original
code and now it prints reports to PDF as Repname-DCR- 20081029 for all
listbox items which has data, but timesout when there is no data on the
report. The code should work with some modifications, but I am not sure how
to do this.

Here is the code which print when there is data:

Private Sub Command66_Click()
Const cInvalidDateError As String = "You have entered an invalid date."
Dim intItem As Integer
Dim blPrintedOK As Boolean
Dim lbo As ListBox
Dim strRep As String
Dim strWhere As String
Dim strCriteria As String
Dim blRet As Boolean
Dim strError As String

Set lbo = Me.Lbopkagt
On Error GoTo Err_Handler
blPrintedOK = True

strCriteria = "1=1"

If IsNull(Me.manager) Then
MsgBox "Please Select A Manager and Retry", vbExclamation, "Invalid
Selection """
Exit Sub
'set the focus to the manager control
' Me.manager.SetFocus
Else
strCriteria = strCriteria & " AND [manager] = '" & Me.manager & "'"
End If

If Not IsNull(Me.Accession) Then
strCriteria = strCriteria & " AND [sgmnt] = '" & Me.Accession & "'"
End If

If IsDate(CDate(Me.txtEndDate)) Then
strCriteria = strCriteria & " AND [reportdate] = " & GetDateFilter((Me.
txtEndDate) + 1)
ElseIf Nz(Me.txtEndDate) <> "" Then
' this doesn't do anything
strError = cInvalidDateError
'say the error and goto the date control
' MsgBox cInvalidDateError
' Exit Sub
' Me.txtEndDate.SetFocus
End If

'loop thru each list box row and print report
For intItem = 0 To lbo.ListCount - 1
strRep = lbo.ItemData(intItem)


' Debug.Print lbo.ItemData(intItem)
strWhere = strCriteria & " AND Repname = """ & strRep & """"
DoCmd.OpenReport "Daily Count By Sales Rep", acIcon, , strWhere,
acHidden
If blPrintedOK Then
blRet = ConvertReportToPDF("Daily Count By Sales Rep", vbNullString, _
"L:\Genpath Reports\Sales Rep Reports\" _
& strRep & "-" & "DCR -" & Format(([Forms]![PDFManagertest]!
[txtEndDate]), "yyyymmdd") & ".pdf", False, False, 0, "", "", 0, 0)
DoCmd.Close acReport, "Daily Count By Sales Rep"

' Debug.Print strWhere
Else
' reset NoData switch - see error handler
blPrintedOK = True
End If
'clear rep name - ready for next rep
strRep = ""

Next

Exit_Handler:
Exit Sub

Err_Handler:

Select Case Err.Number
Case 2501
Err.Clear
Resume Next
Case Else
MsgBox Err.Description, vbExclamation, "Error No: " & Err.Number
End Select

Resume Exit_Handler

End Sub


Thank you

Gmen

Try changing this line

blRet = ConvertReportToPDF(stRptName, vbNullString, strOutputPDFname, False,
False)

to

blRet = ConvertReportToPDF(stRptName, vbNullString, strOutputPDFname, False,
False, 0, "", "", 0, 0)

note: should be on one line!

I'll look into it more tonight.

Hi Steve,

[quoted text clipped - 150 lines]

 

[Steve Sanford]

I'm still here. I'll take a look at it tonight
--
Steve S
--------------------------------
"Veni, Vidi, Velcro"
(I came; I saw; I stuck around.)

Hi Steve,

I am not sure if you are still watching this posting.

But if you are, I picked up a couple of your lines and added to the original
code and now it prints reports to PDF as Repname-DCR- 20081029 for all
listbox items which has data, but timesout when there is no data on the
report. The code should work with some modifications, but I am not sure how
to do this.

Here is the code which print when there is data:

Private Sub Command66_Click()
Const cInvalidDateError As String = "You have entered an invalid date."
Dim intItem As Integer
Dim blPrintedOK As Boolean
Dim lbo As ListBox
Dim strRep As String
Dim strWhere As String
Dim strCriteria As String
Dim blRet As Boolean
Dim strError As String

Set lbo = Me.Lbopkagt
On Error GoTo Err_Handler
blPrintedOK = True

strCriteria = "1=1"

If IsNull(Me.manager) Then
MsgBox "Please Select A Manager and Retry", vbExclamation, "Invalid
Selection """
Exit Sub
'set the focus to the manager control
' Me.manager.SetFocus
Else
strCriteria = strCriteria & " AND [manager] = '" & Me.manager & "'"
End If

If Not IsNull(Me.Accession) Then
strCriteria = strCriteria & " AND [sgmnt] = '" & Me.Accession & "'"
End If

If IsDate(CDate(Me.txtEndDate)) Then
strCriteria = strCriteria & " AND [reportdate] = " & GetDateFilter((Me.
txtEndDate) + 1)
ElseIf Nz(Me.txtEndDate) <> "" Then
' this doesn't do anything
strError = cInvalidDateError
'say the error and goto the date control
' MsgBox cInvalidDateError
' Exit Sub
' Me.txtEndDate.SetFocus
End If

'loop thru each list box row and print report
For intItem = 0 To lbo.ListCount - 1
strRep = lbo.ItemData(intItem)


' Debug.Print lbo.ItemData(intItem)
strWhere = strCriteria & " AND Repname = """ & strRep & """"
DoCmd.OpenReport "Daily Count By Sales Rep", acIcon, , strWhere,
acHidden
If blPrintedOK Then
blRet = ConvertReportToPDF("Daily Count By Sales Rep", vbNullString, _
"L:\Genpath Reports\Sales Rep Reports\" _
& strRep & "-" & "DCR -" & Format(([Forms]![PDFManagertest]!
[txtEndDate]), "yyyymmdd") & ".pdf", False, False, 0, "", "", 0, 0)
DoCmd.Close acReport, "Daily Count By Sales Rep"

' Debug.Print strWhere
Else
' reset NoData switch - see error handler
blPrintedOK = True
End If
'clear rep name - ready for next rep
strRep = ""

Next

Exit_Handler:
Exit Sub

Err_Handler:

Select Case Err.Number
Case 2501
Err.Clear
Resume Next
Case Else
MsgBox Err.Description, vbExclamation, "Error No: " & Err.Number
End Select

Resume Exit_Handler

End Sub


Thank you

Gmen

Try changing this line

blRet = ConvertReportToPDF(stRptName, vbNullString, strOutputPDFname, False,
False)

to

blRet = ConvertReportToPDF(stRptName, vbNullString, strOutputPDFname, False,
False, 0, "", "", 0, 0)

note: should be on one line!

I'll look into it more tonight.

Hi Steve,

[quoted text clipped - 150 lines]

Gmen

 

[Steve Sanford]

I don't understand the change to the Open report command

DoCmd.OpenReport "Daily Count By Sales Rep", acIcon, , strWhere, acHidden

What are the acIcon and acHidden arguments? What version of Access are you
using?

~~
As far as printing, it looks to me the logic should be:

do the setup
get each value in the list box
print the report
if no print error, create a PDF
if print error skip PDF
loop

In the error handler, check for error 2501 (Open report canceled)
set blPrintedOK to false
continue execution at the line following the line that errored


Private Sub Command66_Click()
'------------- <SNIP> ----------
'------------- <SNIP> ----------

'loop thru each list box row and print report
For intItem = 0 To lbo.ListCount - 1
strRep = lbo.ItemData(intItem)

' Debug.Print lbo.ItemData(intItem)
strWhere = strCriteria & " AND Repname = """ & strRep & """"
' Debug.Print strWhere

'DoCmd.OpenReport reportname[, view][, filtername][, wherecondition]
'DoCmd.OpenReport "Daily Count By Sales Rep", , , strWhere

'?????
DoCmd.OpenReport "Daily Count By Sales Rep", acIcon, , strWhere,
acHidden

If blPrintedOK Then
blRet = ConvertReportToPDF("Daily Count By Sales Rep",
vbNullString, _
"L:\Genpath Reports\Sales Rep Reports\" _
& strRep & "-" & "DCR -" &
Format(([Forms]![PDFManagertest]![txtEndDate]), "yyyymmdd") & ".pdf", False,
False, 0, "", "", 0, 0)

' you don't need this
DoCmd.Close acReport, "Daily Count By Sales Rep"

End If
'clear rep name - ready for next rep
strRep = ""

' reset NoData switch - see error handler
blPrintedOK = True

Next

Exit_Handler:
Exit Sub

Err_Handler:

Select Case Err.Number
Case 2501
Err.Clear
blPrintedOK = False '*** REQUIRED ***
Resume Next
Case Else
MsgBox Err.Description, vbExclamation, "Error No: " & Err.Number
End Select

Resume Exit_Handler

End Sub
'-------------------------------------------------------

HTH
--
Steve S
--------------------------------
"Veni, Vidi, Velcro"
(I came; I saw; I stuck around.)

I'm still here. I'll take a look at it tonight
--
Steve S
--------------------------------
"Veni, Vidi, Velcro"
(I came; I saw; I stuck around.)

Hi Steve,

I am not sure if you are still watching this posting.

But if you are, I picked up a couple of your lines and added to the original
code and now it prints reports to PDF as Repname-DCR- 20081029 for all
listbox items which has data, but timesout when there is no data on the
report. The code should work with some modifications, but I am not sure how
to do this.

Here is the code which print when there is data:

Private Sub Command66_Click()
Const cInvalidDateError As String = "You have entered an invalid date."
Dim intItem As Integer
Dim blPrintedOK As Boolean
Dim lbo As ListBox
Dim strRep As String
Dim strWhere As String
Dim strCriteria As String
Dim blRet As Boolean
Dim strError As String

Set lbo = Me.Lbopkagt
On Error GoTo Err_Handler
blPrintedOK = True

strCriteria = "1=1"

If IsNull(Me.manager) Then
MsgBox "Please Select A Manager and Retry", vbExclamation, "Invalid
Selection """
Exit Sub
'set the focus to the manager control
' Me.manager.SetFocus
Else
strCriteria = strCriteria & " AND [manager] = '" & Me.manager & "'"
End If

If Not IsNull(Me.Accession) Then
strCriteria = strCriteria & " AND [sgmnt] = '" & Me.Accession & "'"
End If

If IsDate(CDate(Me.txtEndDate)) Then
strCriteria = strCriteria & " AND [reportdate] = " & GetDateFilter((Me.
txtEndDate) + 1)
ElseIf Nz(Me.txtEndDate) <> "" Then
' this doesn't do anything
strError = cInvalidDateError
'say the error and goto the date control
' MsgBox cInvalidDateError
' Exit Sub
' Me.txtEndDate.SetFocus
End If

'loop thru each list box row and print report
For intItem = 0 To lbo.ListCount - 1
strRep = lbo.ItemData(intItem)


' Debug.Print lbo.ItemData(intItem)
strWhere = strCriteria & " AND Repname = """ & strRep & """"
DoCmd.OpenReport "Daily Count By Sales Rep", acIcon, , strWhere,
acHidden
If blPrintedOK Then
blRet = ConvertReportToPDF("Daily Count By Sales Rep", vbNullString, _
"L:\Genpath Reports\Sales Rep Reports\" _
& strRep & "-" & "DCR -" & Format(([Forms]![PDFManagertest]!
[txtEndDate]), "yyyymmdd") & ".pdf", False, False, 0, "", "", 0, 0)
DoCmd.Close acReport, "Daily Count By Sales Rep"

' Debug.Print strWhere
Else
' reset NoData switch - see error handler
blPrintedOK = True
End If
'clear rep name - ready for next rep
strRep = ""

Next

Exit_Handler:
Exit Sub

Err_Handler:

Select Case Err.Number
Case 2501
Err.Clear
Resume Next
Case Else
MsgBox Err.Description, vbExclamation, "Error No: " & Err.Number
End Select

Resume Exit_Handler

End Sub


Thank you

Gmen

Try changing this line

blRet = ConvertReportToPDF(stRptName, vbNullString, strOutputPDFname, False,
False)

to

blRet = ConvertReportToPDF(stRptName, vbNullString, strOutputPDFname, False,
False, 0, "", "", 0, 0)

note: should be on one line!

I'll look into it more tonight.

Hi Steve,

[quoted text clipped - 150 lines]

Gmen

 

[gm6243 via AccessMonster.com]

Hi Steve,

Thanks for your response and the perfect one. Using the code you gave here, I
got the acheived results. Now, if there is data, it prints the PDF file with
the repname-DCT-date. You are damn good.

for your questions: I am using Access 2003, I had borrowed the line from this
forum for not displaying the report and directly printing it. hence acicon
and achidden.

I am not sure if it is really needed.

I appreciate all you help and cause of guys like you in the forum, I have
improved and learnt a lot.

Thanks Gmen.

I don't understand the change to the Open report command

DoCmd.OpenReport "Daily Count By Sales Rep", acIcon, , strWhere, acHidden

What are the acIcon and acHidden arguments? What version of Access are you
using?

~~
As far as printing, it looks to me the logic should be:

do the setup
get each value in the list box
print the report
if no print error, create a PDF
if print error skip PDF
loop

In the error handler, check for error 2501 (Open report canceled)
set blPrintedOK to false
continue execution at the line following the line that errored

Private Sub Command66_Click()
'------------- <SNIP> ----------
'------------- <SNIP> ----------

'loop thru each list box row and print report
For intItem = 0 To lbo.ListCount - 1
strRep = lbo.ItemData(intItem)

' Debug.Print lbo.ItemData(intItem)
strWhere = strCriteria & " AND Repname = """ & strRep & """"
' Debug.Print strWhere

'DoCmd.OpenReport reportname[, view][, filtername][, wherecondition]
'DoCmd.OpenReport "Daily Count By Sales Rep", , , strWhere

'?????
DoCmd.OpenReport "Daily Count By Sales Rep", acIcon, , strWhere,
acHidden

If blPrintedOK Then
blRet = ConvertReportToPDF("Daily Count By Sales Rep",
vbNullString, _
"L:\Genpath Reports\Sales Rep Reports\" _
& strRep & "-" & "DCR -" &
Format(([Forms]![PDFManagertest]![txtEndDate]), "yyyymmdd") & ".pdf", False,
False, 0, "", "", 0, 0)

' you don't need this
DoCmd.Close acReport, "Daily Count By Sales Rep"

End If
'clear rep name - ready for next rep
strRep = ""

' reset NoData switch - see error handler
blPrintedOK = True

Next

Exit_Handler:
Exit Sub

Err_Handler:

Select Case Err.Number
Case 2501
Err.Clear
blPrintedOK = False '*** REQUIRED ***
Resume Next
Case Else
MsgBox Err.Description, vbExclamation, "Error No: " & Err.Number
End Select

Resume Exit_Handler

End Sub
'-------------------------------------------------------

HTH

I'm still here. I'll take a look at it tonight

[quoted text clipped - 119 lines]