Email different report results to a list (1 Viewer)

[davidcollins01]

I have got a table of staff members which contains their names, department and email address.

I have a database which contains outstaning tasks for those people and i run report based on who's name has been input into a form (so the query behind the report relates to [salescbo] for instance)

What i would like to do is make it so that the report runs a loop and cycles through all those in the staff table who are in sales, and sends a the report based on their name to them.

so.... it checks the table for joe bloggs and runs the report on his name (if he's in sales department), sends it to him, then it moves on to the next member of the sales department and runs the report based on their name, sends it to them.

does anyone have a sample project which does this as i can understand it will be a lot of work to get this working...

 

[reclusivemonkey]

I have something fairly familiar; I'll let you look at the code and see what sense you can make of it, and then ask questions later ;-)

Sub TabProduction()
' For the first three months of the year we need to produce a regular report, and then a _
    & report for the same month
' in last year, but with a current year filter.
    Dim x As Integer
    Dim y As Integer
    Dim z As Integer
    Dim myFMORecordSet As New ADODB.Recordset ' Recordset for FMO List
    ' Dates
    Dim myMonth As Integer ' Month generated from date on frmTabsReport
    Dim myMonthName As String ' Month name string for reports
    Dim myFLYear As String ' Financial Year string for reports
    Dim myPreviousYear As Variant ' For previous year reports in first three months of new financial year
    Dim myYear As String ' Year string for reports
    ' Objects
    Dim mySaveLoc As String
    Dim strBodytext As String
    Dim myReport As String
    Dim myFileName As String
    Dim TotalFMOs As Integer
    Dim FMO As Variant
    Dim countCostCentres As Integer
    Dim myRecipient As String
    Dim myCostCentre As Variant
    Dim Subject As String
    Dim mySubject As String
    Dim Recipient1 As String
    Dim RecipientForename As String
    Dim myWhereCond As String
    ' Arrays
    Static FMOArray() As String
    Static TabArray() As String

    myMonth = ReportMonth(Forms!frmTabsReport!TabMonthEnd)
    mySaveLoc = "S:\Reports\Tabs\"
    myYear = ReportYear(ReportDate(Forms!frmTabsReport!TabMonthEnd)) ' Year is always the current year, _
        but only needed on "PREVIOUS" year filter
    myMonthName = MonthName(myMonth)
    
    myFMORecordSet.Open "SELECT * FROM qryTabsRequired", CurrentProject.Connection, adOpenStatic, _
        adLockReadOnly
        TotalFMOs = myFMORecordSet.RecordCount
        ReDim FMOArray(TotalFMOs) As String
        y = 1
        Do While Not myFMORecordSet.EOF
            FMOArray(y) = myFMORecordSet(1) ' Financial Monitoring Officer
            myFMORecordSet.MoveNext
            y = y + 1
        Loop
    myFMORecordSet.Close
    
    Dim myCostCentreRecordSet As New ADODB.Recordset
    
    For Each FMO In FMOArray()
        myCostCentreRecordSet.Open "SELECT * FROM qryTabsCCents WHERE NAME='" & FMO & "'", _
            CurrentProject.Connection, adOpenStatic, adLockReadOnly
        countCostCentres = myCostCentreRecordSet.RecordCount
        ReDim TabArray(countCostCentres, 4) As String
        x = 0
        myRecipient = FMO
        Do While Not myCostCentreRecordSet.EOF
            x = x + 1
            TabArray(x, 1) = myCostCentreRecordSet(4) ' Recipient
            TabArray(x, 2) = myCostCentreRecordSet(7) ' Cost Centre
            TabArray(x, 3) = myCostCentreRecordSet(6) ' Recipient email
            TabArray(x, 4) = myCostCentreRecordSet(2) ' Recipient forename
            myCostCentreRecordSet.MoveNext
        Loop
    myCostCentreRecordSet.Close
    z = 1
    Do While z <= countCostCentres
        myCostCentre = TabArray(z, 2)
        Forms.frmTabsReport.TabCostCentre.Value = myCostCentre
        Select Case myMonth
            Case 4 To 6
            ' **** Do Current and Previous ****
                ReDim arrReports(4)
                ReDim Preserve TabArray(countCostCentres, 8) As String
                ' CURRENT Detail Report
                myFLYear = ReportFLYear(Forms!frmTabsReport!TabMonthEnd)
                myFileName = mySaveLoc + myRecipient & "-" & myCostCentre & "-" & myMonthName _
                    & "-" & myYear & "-CURRENT-Detail.rtf"
                arrReports(1) = myFileName
                TabArray(z, 5) = mySaveLoc & myFileName
                ' PREVIOUS Detail Report
                myPreviousYear = DateAdd("yyyy", -1, Forms!frmTabsReport!TabMonthEnd)
                myFLYear = ReportFLYear(ReportDate(myPreviousYear))
                myFileName = mySaveLoc + myRecipient & "-" & myCostCentre & "-" & myMonthName _
                    & "-" & myYear & "-PREVIOUS-Detail.rtf"
                arrReports(2) = myFileName
                TabArray(z, 6) = mySaveLoc & myFileName
                ' CURRENT Summary Report
                myFileName = mySaveLoc + myRecipient & "-" & myCostCentre & "-" & myMonthName _
                    & "-" & myYear & "-CURRENT-Summary.rtf"
                arrReports(3) = myFileName
                TabArray(z, 7) = mySaveLoc & myFileName
                ' PREVIOUS Summary Report
                myFileName = mySaveLoc + myRecipient & "-" & myCostCentre & "-" & myMonthName _
                    & "-" & myYear & "-PREVIOUS-Summary.rtf"
                arrReports(4) = myFileName
                TabArray(z, 8) = mySaveLoc & myFileName
                Subject = myMonthName & "-" & myYear & " Tab Reports"
                Recipient1 = TabArray(z, 3)
                RecipientForename = TabArray(z, 4)
            Case Else
                ' Just do Current
                ReDim arrReports(2) As Variant
                ReDim Preserve TabArray(countCostCentres, 6) As String
                ' Current Detail Report
                myReport = "rptTabDetail"
                myFLYear = ReportFLYear(Forms!frmTabsReport!TabMonthEnd)
                myFileName = mySaveLoc + myRecipient & "-" & myCostCentre & "-" & myMonthName _
                    & "-" & myYear & "-CURRENT-Detail.rtf"
                myWhereCond = "CCENT_CODE = '" & myCostCentre & "' AND MONTH_NUMBER = '" & _
                    myMonth & "' AND FL_YEAR = '" & myFLYear & "'"
                DoCmd.OpenReport myReport, acViewPreview, , myWhereCond
                DoCmd.OutputTo acOutputReport, myReport, acFormatRTF, myFileName
                DoCmd.Close acReport, myReport, acSaveNo
                arrReports(1) = myFileName
                TabArray(z, 5) = myFileName
                ' Current Summary Report
                myReport = "rptTabSummary"
                myFileName = mySaveLoc + myRecipient & "-" & myCostCentre & "-" & myMonthName _
                    & "-" & myYear & "-CURRENT-Summary.rtf"
                DoCmd.OpenReport myReport, acViewPreview
                DoCmd.OutputTo acOutputReport, myReport, acFormatRTF, myFileName
                DoCmd.Close acReport, myReport, acSaveNo
                arrReports(2) = myFileName
                TabArray(z, 6) = mySaveLoc & myFileName
                mySubject = myMonthName & "-" & myYear & " Tab Reports"
                Recipient1 = TabArray(z, 3)
                RecipientForename = TabArray(z, 4)
                strBodytext = "Dear " & RecipientForename & ","
                strBodytext = strBodytext + vbCrLf & vbCrLf & "Please find enclosed your Tab" _
                    & " reports for " & myMonthName & " " & myYear & ". "
                strBodytext = strBodytext + vbCrLf & vbCrLf & "Please find enclosed your Summary" _
                    & " Tab report for " & myMonthName & " " & myYear & "."
                strBodytext = strBodytext + " Regards," & vbCrLf
                strBodytext = strBodytext + vbCrLf & vbCrLf & "Luke Brunning"
                Groupwise_Mail TabArray(z, 3), arrReports(), mySubject, strBodytext
                z = z + 1
            End Select
        Loop
    Next FMO
    Beep
    MsgBox "All tabs have been produced, saved to " & mySaveLoc & " and emailed to the relevant FMOs."
End Sub

 

[davidcollins01]

Thanks for that, i'll have a look through and see what i can make of it

cheerz