run report for different suppliers

[rainbows]

hi

below is some code that someone helped me with in a different database and works great

but I want to modify it to another database , the new one does not have a field called status with the result " active "
si i dont know how to modifyy it i have attached the new database i am trying to use for you. can you please have a look and help me change it to send a report to each supplier just with thier outstanding Po

you will see a drop down box on the form , please select "outstandingpoby supplier

thanks you

strCriteria = "[STATUS]=""ACTIVE"""
                If DCount("1", "Issues", "Status=""Active""") <> 0 Then
                    With CurrentDb.OpenRecordset("SELECT DISTINCT [Assigned To] FROM [Issues] " & _
                                        "WHERE [Status]=""Active""")
                        If Not (.BOF And .EOF) Then .MoveFirst
                        i = 0
                        While Not .EOF
                            i = i + 1
                            thisCriteria = strCriteria & " And [Assigned To]=" & Nz(.Fields(0).Value, 0)
                            eMail = DLookup("[E-mail Address]", "Contacts", "ID=" & Nz(.Fields(0).Value, 0))
                            '* close report if already open
                            If SysCmd(acSysCmdGetObjectState, acReport, cboReports.Value) <> 0 Then
                                DoCmd.Close acReport, cboReports.Value
                            End If
                            DoCmd.OpenReport REPORTNAME:=cboReports, VIEW:=acViewPreview, WHERECONDITION:=thisCriteria
                            '* this is a test
                            '* DoCmd.OutputTo acOutputReport, cboReports.Value, acFormatPDF, Environ("userprofile") & "\documents\rpt" & i & ".pdf", True
                            DoCmd.SendObject acSendReport, cboReports.Value, acFormatPDF, eMail, , , "Open Issues", _
                                "Your prompt action is required for the following issues!"
                            DoCmd.Close acReport, cboReports.Value
                            .MoveNext
                        Wend
                     End With
                End If

 

[JHB]

Does it not run if you remove all about the "Active" or what is the problem then?

 

[June7]

A lot more has to change than just the snippet you posted. This may be a major re-write. Objects referenced do not exist. Compiler dies on Me.TextReportOption right off. There is no Issues table or query. What should be referenced instead of those?

 

[rainbows]

hi,

the last database worked on a field called status and active , and it just sent reports to the people who had tasks to do , it only sent them their tasks

this time I have a list of " outstanding PO;s" and I want to send the outstanding PO.S to the supplier in the list. but only their POs

so I don't know to change the code to look at the suppliers in the list and e-mail them just theirs

hope this helps

steve

 

[June7]

A very simple example of possible code:

Dim rsSup As DAO.Recordset
Set rsSup = CurrentDb.OpenRecordset("SELECT ID, [E-mail Address] FROM suppliers")
Do While Not rsSup.EOF
    DoCmd.OpenReport Me.cboReports, acViewPreview, , "ID=" & rsSup!ID
    DoCmd.SendObject acSendReport, Me.cboReports, acFormatPDF, rsSup![E-Mail Address], "something here", "something here", True
    DoCmd.Close acReport, Me.cboReports, acSaveNo
    rsSup.MoveNext
Loop

If you need something as elaborate as the current code, you need to figure that out.

Maybe a little late to consider, but really should avoid using spaces and punctuation/special characters (underscore only exception) in naming convention.

 

[Gasman]

Don't we need a rsSup.MoveNext in that loop?

 

[June7]

Ooops, yes, edited post. You know how many times I end up in endless loop because of that stupid oversight And my HP Pavilion laptop does not have Break button. Ahhg!

 

[rainbows]

hi,

thank you , it is giving me each suppliers line po order. I really need it to give me all the individuals suppliers list in one e-mail . example "ALLSEALS (EAST ANGLIA) LIMITED"
one list should contain 25 records

thank you

steve

 

[June7]

Which report?

Suggested code will send email to a single address. The report will include all records that meet criteria. If you want report to filter by SupplierCode or Supplier then adjust code.

I see some companies have multiple SupplierCode. Really should not save company name into OutstandingPO table.

Post your actual code.

 

[rainbows]

hi
really appreciate your help
the code I am trying to use is this

you are correct it should be by suppliercode

Private Sub cboReports_AfterUpdate()

 Dim strCriteria As String
    Dim thisCriteria As String
    Dim eMail As String
    Dim Title As String
    Dim Message As String
    Dim i As Integer
    DoCmd.OpenForm FormName:="ReportDialog", WindowMode:=acDialog
    '* check if [TextReportOption] <> 0
    If Me.TextReportOption <> 0 Then
        strCriteria = "(1=1)" '(1=1) means it is always True, therefore returns all records
        Select Case Me.TextReportOption
        Case Is = 1 'Print Preview
            '* Open the report with criteria
            DoCmd.OpenReport REPORTNAME:=cboReports, VIEW:=acViewReport, WHERECONDITION:=strCriteria
        Case Is = 2 'Print
            '* Open the report with criteria
            DoCmd.OpenReport REPORTNAME:=cboReports, VIEW:=acViewNormal, WHERECONDITION:=strCriteria
        Case Is = 3 'Email report
        
         If cboReports = "Outstandingpobysupplier" Then
         
         
         Dim rsSup As DAO.Recordset
Set rsSup = CurrentDb.OpenRecordset("SELECT ID, [E-mail Address] FROM suppliers")
Do While Not rsSup.EOF
    DoCmd.OpenReport Me.cboReports, acViewPreview, , "ID=" & rsSup!ID
    
    
    
    
    DoCmd.SendObject acSendReport, Me.cboReports, acFormatPDF, rsSup![E-Mail Address], "", "", True
    DoCmd.Close acReport, Me.cboReports, acSaveNo
    rsSup.MoveNext
Loop
         
   
           
               
            
         
                 
                     
         
                                       
                           
                            
                 
             
            Else
                
                '* add Title and Message below
                '*
                Select Case cboReports.Value
                
                    'Title =
                    'Message =
               Case Is = "Contact Address Book"
                Case Is = "Contact Phone Book"
                Case Is = "Issue Details"
                  Case Is = " closed issues"
                Case Is = " outstandingpo"
                                
                End Select
                                
                'With CurrentDb.OpenRecordset("SELECT DISTINCT [E-mail Address] FROM [Contacts];")
               With CurrentDb.OpenRecordset("SELECT DISTINCT [E-mail Address] FROM [suppliers];")
                   If Not (.BOF And .EOF) Then .MoveFirst
                   i = 0
                    While Not .EOF
                       i = i + 1
                  '     '* close report if already open
                       If SysCmd(acSysCmdGetObjectState, acReport, cboReports.Value) <> 0 Then
                            DoCmd.Close acReport, cboReports.Value
                        End If
                        DoCmd.OpenReport REPORTNAME:=cboReports, VIEW:=acViewPreview, WHERECONDITION:=thisCriteria
                        ''* this is a test
                       ' * DoCmd.OutputTo acOutputReport, cboReports.Value, acFormatPDF, Environ("userprofile") & "\documents\rpt" & i & ".pdf", True
                        DoCmd.SendObject acSendReport, cboReports.Value, acFormatPDF, .Fields(0).Value, , , Title, Message
                        DoCmd.Close acReport, cboReports.Value
                        .MoveNext
                    Wend
               End With
            
           End If
       End Select
    End If


    
End Sub

this part of the code is giving me a -1 in the description body of the e-mail and trying was tying to put a CC e-mail contact

   DoCmd.SendObject acSendReport, Me.cboReports, acFormatPDF, rsSup![E-Mail Address], "", "", True

thank you

 

[June7]

You have no text in the Subject and Body arguments.

The ID filter is referencing the ID field in OutstandingPO. Change to pull the SupplierCode or Supplier if you want to filter by company.

Set rsSup = CurrentDb.OpenRecordset("SELECT SupplierCode, CompanyName, [E-mail Address] FROM suppliers")

DoCmd.OpenReport Me.cboReports, acViewPreview, , "Supplier='" & rs!CompanyName & "'"

Or change that line to use SupplierCode. You will get different output because some companies have multiple codes.

Should check the design of reports. Couple are too wide for paper and Supplier label is not over Supplier field.

 

[rainbows]

hi
thanks for all your help

I have attached the file so you can look at what is not quite working
I think it is very close now but I am not good at vba to really tell

thank steve

 

[June7]

There is a typo error in the code. The red text is missing:

DoCmd.OpenReport Me.cboReports, acViewPreview, , "Supplier='" & rsSup!CompanyName & "'"

Code errors if supplier does not have an email address. Modify the query SQL:

Set rsSup = CurrentDb.OpenRecordset("SELECT SupplierCode, CompanyName, [E-mail Address] FROM suppliers WHERE Not [E-Mail Address] Is Null")

Have you run Debug > Compile? This fails on: Me.TextReportOption. But the code still runs, which is odd.

You need to learn how to debug code. See link at bottom of my post.

Every code module should have Option Explicit in the header section. https://docs.microsoft.com/en-us/do...eference/statements/option-explicit-statement