Need help in writing VB code to loop through a List Box and create separate PDFs (1 Viewer)

[Gasman]

PMFJI, but your code looks like it is processing EVERY item in the list box, not just the ones you have selected. You should see that when you step through the code?

jddraw gave you a hint with the links to .ItemsSelected

https://msdn.microsoft.com/en-us/library/office/ff823015.aspx?f=255&MSPPError=-2147217396

If this is not the case, then my apologies.

Also Do.Cmd.OutputTo does not appear to have a parameter for criteria?
https://msdn.microsoft.com/en-us/library/office/ff192065.aspx

I think you will need DoCmd.OpenReport which you were using and specify the criteria correctly.

Here is a sample of code I have used in the past. This prints out a report dependant on the value in the combo box. Ignore the CopyObject, I had to use that to get the pdf in the correct name as I am on 2003. Also try closing the report each time. That might fix your one big report problem?

Private Sub cmdShip_Click()
On Error GoTo Err_cmdShip_Click

    Dim stRptName As String, stParam As String, stLinkCriteria As String
    Dim iPreview As Integer, iDialog As Integer
    
    iPreview = 0
    iDialog = 0
    If Me.ChkPreview Then
        iPreview = 2
        iDialog = 3
    End If
    stRptName = "Main_by_Ship"
    
    stParam = Replace(LCase(Me.cboShip.value), " ", "_")
    stLinkCriteria = "[Ship] = '" & Me.cboShip.value & "'"
    
    DoCmd.CopyObject , stParam, acReport, stRptName
    DoCmd.OpenReport stParam, iPreview, , stLinkCriteria, iDialog

    DoCmd.Close acReport, stParam
    DoCmd.DeleteObject acReport, stParam

Exit_cmdShip_Click:
    Exit Sub

Err_cmdShip_Click:
    MsgBox Err.description
    Resume Exit_cmdShip_Click
    
End Sub

 

[jdraw]

New look at your request:
Can you go back and describe the basics again?

You have a list of People/salespersons.

You want to select 1 or more SalesPersons, create a report with data for the selected salesPersons and then output that report as a pdf.

Is that the process? I'm not following where/why there is repeated looping???

 

[brosenfelt]

Sorry if my last couple of posts were unclear -- several of them were made late last night!

The reason I need looping, is that I want to create a SEPARATE report for each salesperson selected from the LIst Box. So, as an example, if I select Bob, Joe, and Mary, I want to create three separate PDF reports, each with a single salesperson as the criteria.

The List Box has a list of all salespersons.

The query that is the source for the report has a criteria looking for input from the List Box.

Does that make sense??

 

[jdraw]

Sort of - let me repeat back for clarity - it was late last night for me too.

You have a listbox with values for say Allen, Bob, Frank, Joe, Mary

You select Bob, Joe and Mary from the listbox
For each selected Person
you create a report specific to that Person
you do something with each report
Next Person

Then what?

 

[brosenfelt]

Sort of - let me repeat back for clarity - it was late last night for me too.

You have a listbox with values for say Allen, Bob, Frank, Joe, Mary

You select Bob, Joe and Mary from the listbox
For each selected Person
you create a report specific to that Person
you do something with each report
Next Person

Then what?

Yes, for each salesperson, a report (based on that salesperson) is generated and saved. Then the next, etc. Once complete -- that's it.

 

[jdraw]

OK, I mocked up a sample form. ( I have updated with a jpg of the form)

The key issue is to show the looping through selected items in a listbox.

The form has a listbox (list0),, and a button(btnrun)
The data in the listbox (rowsource) is

SELECT Animal.AName
FROM Animal;

My data:

AName
Spot
Jim
Sam
David
BlueEyes
Capitan
Johnny

Code for the click event:

'---------------------------------------------------------------------------------------
' Procedure : btnrun_Click
' Author    : mellon
' Date      : 20/08/2015
' Purpose   : mock up form with listbox and a button.
'          Items are selected from listbox.  
'              Then  via a loop
'          Each item is sent to a function to create/open a report for the selected "person"
'          Each item is sent to a function
'---------------------------------------------------------------------------------------
'
Private Sub btnrun_Click()
          Dim ctrl As Control
          Dim i As Integer
10       On Error GoTo btnrun_Click_Error

20        Set ctrl = Me.List0
          [COLOR="Red"]If ctrl.ItemsSelected.Count = 0 Then Exit Sub[/COLOR]
30       For i = 1 To ctrl.ItemsSelected.Count 'Process/loop through selected items
           'Debug.Print "checking Loop logic with  " & ctrl.ItemData(i) '''for debugging
40         DoEvents ''  seems necessary to slow the processing
50             doBuildReport (ctrl.ItemData(i)) 'simulated function where report building with selected personName
60             doSendReport (ctrl.ItemData(i))  'simulated function to send report to selected Person
70        Next i

80       On Error GoTo 0
90       Exit Sub

btnrun_Click_Error:

100       MsgBox "Error " & Err.number & "  in line " & Erl & " (" & Err.Description & ") in procedure btnrun_Click of VBA Document Form_Form18"
End Sub

Simulated function to OpenReport

Function doBuildReport(PersonName)
'MsgBox "Create a report for " & PersonName  'debugging aid to show function was executed
Debug.Print Now & "    Report created for " & PersonName  'simulate a Log entry
End Function

Simulated function to send the report:

Function doSendReport(PersonName)
'MsgBox "Send a report for " & PersonName   'debugging aid to show function was executed
Debug.Print Now & "    Report sent for " & PersonName  'simulate a Log entry
End Function

The output for my test is:

20/08/2015 4:12:55 PM Report created for Jim
20/08/2015 4:12:55 PM Report sent for Jim
20/08/2015 4:12:55 PM Report created for Sam
20/08/2015 4:12:55 PM Report sent for Sam
20/08/2015 4:12:55 PM Report created for David
20/08/2015 4:12:55 PM Report sent for David

 

[brosenfelt]

Thanks for doing the mock up. Following your logic, I've got the following (ignore the commented lines from a previous version of the code):

Private Sub Command3_Click()

Dim i As Integer
Dim lbox As ListBox
Dim myPath As String
Dim strReportName As String

Set lbox = Me![List0]
myPath = "C:\Users\ROSENBR\Documents\BRC\Report\"


'For i = 0 To lbox.ListCount - 1 original statement
 For i = 0 To lbox.ItemsSelected.Count 'Access each item with
   'Me.ListBoxName.ItemData(i)
   strReportName = lbox.ItemData(i)
   'lbox = lbox.ItemData(i)
   DoCmd.OpenReport "Pipeline - All Rms - AUTO-REPORT", acViewPreview, lbox.ItemData(i), , acHidden
   DoCmd.OutputTo acOutputReport, "Pipeline - All Rms - AUTO-REPORT", acFormatPDF, myPath & strReportName & ".pdf", False, , , acExportQualityPrint
   DoCmd.Close acReport, "Pipeline - All Rms - AUTO-REPORT", acSaveNo
   'Debug.Print lbox.ItemData(i)
Next i

End Sub

This is getting me VERY close; but now, if I select two different sales persons , I get the first 3 salespeople in the List Box's reports saved. I know I am very close....ugh.

Thoughts?

 

[jdraw]

My code should work for your listbox looping. You'll have to adjust for your names, but the core logic should be OK.

 

[brosenfelt]

I tried it -- but kept getting the first X number of salespeople in the list...not the specific ones I picked. Ideas?? I've been playing with using "For Each varItm In lbox.ItemsSelected", but having trouble passing the resulting salesperson value to the OpenReport line:

Private Sub Command3_Click()

Dim i As Integer
Dim lbox As ListBox
Dim myPath As String
Dim strReportName As String
Dim varItm As Variant
Dim str As String

str = ""
Set lbox = Me!List0
myPath = "C:\Users\ROSENBR\Documents\BRC\Report\"

If lbox.ItemsSelected.Count = 0 Then
MsgBox ("No items are currently selected.")
Exit Sub
End If

For Each varItm In lbox.ItemsSelected
strReportName = lbox.ItemData(varItm)
Debug.Print "chcking Loop logic with " & lbox.Column(0, varItm)
Debug.Print "2nd debug:" & strReportName
DoCmd.OpenReport "Pipeline - All Rms - AUTO-REPORT", acViewPreview, , , acWindowNormal, strReportName
DoCmd.OutputTo acOutputReport, "Pipeline - All Rms - AUTO-REPORT", acFormatPDF, myPath & strReportName & ".pdf", False, , , acExportQualityPrint
DoCmd.Close acReport, "Pipeline - All Rms - AUTO-REPORT", acSaveNo
Next varItm


'For i = 0 To lbox.ListCount - 1 original statement
'For i = 0 To lbox.ItemsSelected.Count - 1 'Access each item with
'Me.ListBoxName.ItemData(i)
'strReportName = lbox.ItemData(i)
'Debug.Print "checking Loop logic with " & lbox.ItemData(i) '''for debugging
'DoEvents
'DoCmd.OpenReport "Pipeline - All Rms - AUTO-REPORT", acViewPreview, lbox.ItemData(i), , acHidden
'DoCmd.OutputTo acOutputReport, "Pipeline - All Rms - AUTO-REPORT", acFormatPDF, myPath & strReportName & ".pdf", False, , , acExportQualityPrint
'DoCmd.Close acReport, "Pipeline - All Rms - AUTO-REPORT", acSaveNo
'Debug.Print lbox.ItemData(i)
'Next i

End Sub

 

[jdraw]

I added a line of code (in red) to my procedure in post # 26 to check for the No Records Selected.

Also note in my example, the selected items are iterated from 1 to .count

For i = 1 To ctrl.ItemsSelected.Count 'Process/loop through selected items

Why don't you try that same looping approach? It's been tested and shows that it works.

You can rename your Command3_Click()
to OLD_Command3_Click(),
then rebuild a new Command3_Click()
for testing.

 

[brosenfelt]

OK - went back and used the code you wrote:

Private Sub Command3_Click()


          Dim ctrl As Control
          Dim i As Integer
10       On Error GoTo btnrun_Click_Error

20        Set ctrl = Me.List0
          
30       For i = 1 To ctrl.ItemsSelected.Count 'Process/loop through selected items
           Debug.Print "checking Loop logic with  " & ctrl.ItemData(i) '''for debugging
40         DoEvents ''  seems necessary to slow the processing
50             doBuildReport (ctrl.ItemData(i)) 'simulated function where report building with selected personName
60             doSendReport (ctrl.ItemData(i))  'simulated function to send report to selected Person
70        Next i

80       On Error GoTo 0
90       Exit Sub

btnrun_Click_Error:

100       MsgBox "Error " & Err.Number & "  in line " & Erl & " (" & Err.Description & ") in procedure btnrun_Click of VBA Document Form_Form18"
End Sub

Function doBuildReport(PersonName)
'MsgBox "Create a report for " & PersonName  'debugging aid to show function was executed
Debug.Print Now & "    Report created for " & PersonName  'simulate a Log entry
End Function

Function doSendReport(PersonName)
'MsgBox "Send a report for " & PersonName   'debugging aid to show function was executed
Debug.Print Now & "    Report sent for " & PersonName  'simulate a Log entry
End Function

I've attached a screen shot of my form. Here is the debug output:

8/20/2015 6:32:45 PM Report sent for Christy Sowder
checking Loop logic with Chad Greene
8/20/2015 6:32:45 PM Report created for Chad Greene
8/20/2015 6:32:45 PM Report sent for Chad Greene

So - close....but not select the specific salespeople...just the first two (in this case) from the list. Thoughts?

 

[jdraw]

OK. I have just relooked at the material I sent. I found an issue.
Give me a bit of time to check. I'll get back to you.
Sorry for the inconvenience.

 

[brosenfelt]

I think I got it (will test when I get home):

Dim i As Integer
Dim lbox As ListBox
Dim myPath As String
Dim strReportName As String
Dim varItm As Variant
Dim str As String

str = ""
Set lbox = Me!List0
myPath = "C:\Users\ROSENBR\Documents\BRC\Report\"

If lbox.ItemsSelected.Count = 0 Then
MsgBox ("No items are currently selected.")
Exit Sub
End If

For Each varItm In lbox.ItemsSelected
        strReportName = lbox.Column(0, varItm)
            Debug.Print "chcking Loop logic with " & lbox.Column(0, varItm)
            Debug.Print "2nd debug:" & strReportName
            Debug.Print "[RM_FULL_NAME]= " & """" & lbox.Column(0, varItm) & """"
    DoCmd.OpenReport "Pipeline - All Rms - AUTO-REPORT", acViewPreview, , "[RM_FULL_NAME]=" & """" & strReportName & """", acWindowNormal
    DoCmd.OutputTo acOutputReport, "Pipeline - All Rms - AUTO-REPORT", acFormatPDF, myPath & strReportName & ".pdf", False, , , acExportQualityPrint
    DoCmd.Close acReport, "Pipeline - All Rms - AUTO-REPORT", acSaveNo
Next varItm

Removed the criteria in the query, and used the WHERE argument of OpenReport to pass the criteria.

 

[brosenfelt]

Eureka!!!!!! Works

Phew. Thank you for all of your help!!!!!!

 

[jdraw]

OK. Revamped and retested. Sorry for the inconvenience.

I had to use a variant and used the For Each...
Then used the variant for the ItemData(..variant..)

Try this one.

'---------------------------------------------------------------------------------------
' Procedure : btnrun_Click
' Author    : mellon
' Date      : 20/08/2015
' Purpose   : mock up form with listbox and a button.
'          Items are selected from listbox via a loop
'          Each item is sent to a function to create/open a report for the selected "person"
'          Each item is sent to a function
'---------------------------------------------------------------------------------------
'
Private Sub btnrun_Click()
          Dim ctrl As Control
          Dim varItem As Variant  '<---had to change to variant
10      On Error GoTo btnrun_Click_Error

20        Set ctrl = Me.List0

      ' ==For Debugging =====
30        Debug.Print "Count of Selected Items:  :    " & ctrl.ItemsSelected.Count & vbCrLf & vbCrLf

40        For Each varItem In ctrl.ItemsSelected

50             doBuildReport (ctrl.ItemData(varItem)) 'simulated function where report building with selected personName
60             doSendReport (ctrl.ItemData(varItem))  'simulated function to send report to selected Person

70        Next varItem
          
80        On Error GoTo 0
90        Exit Sub

btnrun_Click_Error:

100       MsgBox "Error " & Err.number & "  in line " & Erl & " (" & Err.Description & ") in procedure btnrun_Click of VBA Document Form_Form18"
End Sub

Results:

Count of Selected Items: : 3


20/08/2015 7:34:04 PM Report created for Jim
20/08/2015 7:34:04 PM Report sent for Jim
20/08/2015 7:34:04 PM Report created for David
20/08/2015 7:34:04 PM Report sent for David
20/08/2015 7:34:04 PM Report created for BlueEyes
20/08/2015 7:34:04 PM Report sent for BlueEyes