Search code examples
vbaemailms-accessforeach

For Each control sending an email with multiple attachments based off of checkbox criteria


I am trying to send multiple reports on the same email.

I have a form where users can select which list a Buyer will appear on. There are seven possible lists, and they can be on any amount of them. I prefer not to write out all the individual cases.

I have named each of the checkboxes to their respective List Names in testing - they are Active, Cabinet, Distribution, MH, OEM, RV, & Salvage.

Private Sub Btn_Generate_Email_Click()
    
    Dim OLApp As Outlook.Application
    Dim OLMsg As Outlook.MailItem
    
    Dim TodayDate As String
    Dim Path As String
    
    Dim ActiveReportName As String
    Dim CabinetReportName As String
    Dim DistributionReportName As String
    Dim MHReportName As String
    Dim OEMReportName As String
    Dim RVReportName As String
    Dim SalvageReportName As String
    Dim ReportName As String
    
    Dim Control As Control
    Dim ControlName As String
    
    Set OLApp = CreateObject("Outlook.Application")
    Set OLMsg = OLApp.CreateItem(olMailItem)
    
    TodayDate = Format(Date, "MM") & "-" & Format(Date, "DD") & "-" & Format(Date, "YYYY") 'Formats Today's date in MM-DD-YYYY
    
    Path = CurrentProject.Path & "\" & "Access PDFs" 'Finds current AccessDB path and grabs the folder Access PDFs
    
    ActiveReportName = Path & "\" & "Active List - " & TodayDate & ".pdf"
    
    CabinetReportName = Path & "\" & "Cabinet List - " & TodayDate & ".pdf"
    
    DistributionReportName = Path & "\" & "Distribution List - " & TodayDate & ".pdf"
    
    MHReportName = Path & "\" & "MH List - " & TodayDate & ".pdf"
    
    OEMReportName = Path & "\" & "OEM List - " & TodayDate & ".pdf"
    
    RVReportName = Path & "\" & "RV List - " & TodayDate & ".pdf"
    
    SalvageReportName = Path & "\" & "Salvage List - " & TodayDate & ".pdf"
    
    ReportName = "ReportName"
    
    'Create all necessary reports and outputs them to folder Access PDFs inside AccessDB Path 
    DoCmd.OutputTo acOutputReport, "Rpt_ActiveOpenQuantity", acFormatPDF, ActiveReportName, False
    DoCmd.OutputTo acOutputReport, "Rpt_CabinetOpenQuantity", acFormatPDF, CabinetReportName, False
    DoCmd.OutputTo acOutputReport, "Rpt_DistributionOpenQuantity", acFormatPDF, DistributionReportName, False
    DoCmd.OutputTo acOutputReport, "Rpt_MHOpenQuantity", acFormatPDF, MHReportName, False
    DoCmd.OutputTo acOutputReport, "Rpt_OEMOpenQuantity", acFormatPDF, OEMReportName, False
    DoCmd.OutputTo acOutputReport, "Rpt_RVOpenQuantity", acFormatPDF, RVReportName, False
    DoCmd.OutputTo acOutputReport, "Rpt_SalvageOpenQuantity", acFormatPDF, SalvageReportName, False
    
    With OLMsg
        .Display
        .To = Forms!Frm_BuyerList!Buyer_Email
        .Subject = "This is the subject of the email."
        .Body = "This is the body of the email."
        
        For Each Control In Me.Form.Controls
            If Control.ControlType = acCheckBox Then
                If Control = -1 Then
                    .Attachments.Add Control.Name & ReportName
                End If
            End If
        Next Control

    End With

    Set OLMsg = Nothing
    Set OLApp = Nothing

This bottom portion of the For Each control is where I error out. I had attempted to dynamically reference my own object then realized control.name and reportname come back as strings.

I have had it in the past where it added the same report seven times, but I think I was getting stuck in my first If statement coming back true and then it firing the same line six extra times.


Here is updated code if anyone else has this same issue in the future.

    Dim OLApp As Outlook.Application
    Dim OLMsg As Outlook.MailItem
    
    Dim TodayDate As String
    Dim Path As String
    
    Dim ActiveReportName As String
    Dim CabinetReportName As String
    Dim DistributionReportName As String
    Dim MHReportName As String
    Dim OEMReportName As String
    Dim RVReportName As String
    Dim SalvageReportName As String
    Dim ReportPath As String
    
    Dim Ctrl As Control
    
    Set OLApp = CreateObject("Outlook.Application")
    Set OLMsg = OLApp.CreateItem(olMailItem)
    
    TodayDate = Format(Date, "MM-DD-YYYY") 'Formats Today's date in MM-DD-YYYY
    
    Path = CurrentProject.Path & "\Access PDFs" 'Finds current AccessDB path and grabs the folder Access PDFs - later add logical if to create folder if it doesnt exist
    
    ActiveReportName = Path & "\Active List - " & TodayDate & ".pdf"
    
    CabinetReportName = Path & "\Cabinet List - " & TodayDate & ".pdf"
    
    DistributionReportName = Path & "\Distribution List - " & TodayDate & ".pdf"
    
    MHReportName = Path & "\MH List - " & TodayDate & ".pdf"
    
    OEMReportName = Path & "\OEM List - " & TodayDate & ".pdf"
    
    RVReportName = Path & "\RV List - " & TodayDate & ".pdf"
    
    SalvageReportName = Path & "\Salvage List - " & TodayDate & ".pdf"
    
    'Create all necessary reports and outputs them to folder Access PDFs inside AccessDB Path
    DoCmd.OutputTo acOutputReport, "Rpt_ActiveOpenQuantity", acFormatPDF, ActiveReportName, False
    DoCmd.OutputTo acOutputReport, "Rpt_CabinetOpenQuantity", acFormatPDF, CabinetReportName, False
    DoCmd.OutputTo acOutputReport, "Rpt_DistributionOpenQuantity", acFormatPDF, DistributionReportName, False
    DoCmd.OutputTo acOutputReport, "Rpt_MHOpenQuantity", acFormatPDF, MHReportName, False
    DoCmd.OutputTo acOutputReport, "Rpt_OEMOpenQuantity", acFormatPDF, OEMReportName, False
    DoCmd.OutputTo acOutputReport, "Rpt_RVOpenQuantity", acFormatPDF, RVReportName, False
    DoCmd.OutputTo acOutputReport, "Rpt_SalvageOpenQuantity", acFormatPDF, SalvageReportName, False
    
    With OLMsg
        .Display
        .To = Forms!Frm_BuyerList!Buyer_Email
        .Subject = "This is the subject of the email."
        .Body = "This is the body of the email."
        
        For Each Ctrl In Me.Form.Controls
            If Ctrl.ControlType = acCheckBox Then
                If Ctrl = -1 Then
                    ReportPath = CurrentProject.Path & "\Access PDFs\" & _
                      Ctrl.Name & " List - " & Format(Date, "MM-DD-YYYY") & ".pdf"
                    .Attachments.Add ReportPath
                End If
            End If
        Next Ctrl

    End With
    
    Set OLMsg = Nothing
    Set OLApp = Nothing

Solution

  • You can create a function which maps control name to report path.

    Something like this:

    Private Sub Btn_Generate_Email_Click()
        Dim OLApp As Outlook.Application
        Dim OLMsg As Outlook.MailItem
        Dim Con As Control
        Dim ControlName As String
        
        Set OLApp = CreateObject("Outlook.Application")
        Set OLMsg = OLApp.CreateItem(olMailItem)
        
        'Create all necessary reports and outputs them to folder Access PDFs inside AccessDB Path
        DoCmd.OutputTo acOutputReport, "Rpt_ActiveOpenQuantity", acFormatPDF, ReportPath("Active"), False
        DoCmd.OutputTo acOutputReport, "Rpt_CabinetOpenQuantity", acFormatPDF, ReportPath("Cabinet"), False
        DoCmd.OutputTo acOutputReport, "Rpt_DistributionOpenQuantity", acFormatPDF, ReportPath("Distribution"), False
        DoCmd.OutputTo acOutputReport, "Rpt_MHOpenQuantity", acFormatPDF, ReportPath("MHR"), False
        DoCmd.OutputTo acOutputReport, "Rpt_OEMOpenQuantity", acFormatPDF, ReportPath("OEM"), False
        DoCmd.OutputTo acOutputReport, "Rpt_RVOpenQuantity", acFormatPDF, ReportPath("RVR"), False
        DoCmd.OutputTo acOutputReport, "Rpt_SalvageOpenQuantity", acFormatPDF, ReportPath("Salvage"), False
        
        
        With OLMsg
            .Display
            .To = Forms!Frm_BuyerList!Buyer_Email
            .Subject = "This is the subject of the email."
            .Body = "This is the body of the email."
            
            For Each Control In Me.Form.Controls
                If Control.ControlType = acCheckBox Then
                    If Control = -1 Then
                        .Attachments.Add ReportPath(Control.Name)
                    End If
                End If
            Next Control
        End With
    End Sub
    
    'cName = Active, Cabinet, Distribution, MHR, OEM, RVR, Salvage
    Function ReportPath(cName As String) As String
        ReportPath = CurrentProject.Path & "\Access PDFs\" & _
                    cName & " List - " & Format(Date, "MM-DD-YYYY") & ".pdf"
    End Function