excelvbacheckboxoutlook

Select checkbox to email items


I have checkboxes and items in the sheet and I want to email items when the checkboxes are selected.

I have this error

Subscript out of range

Spreadsheet I'm testing on:
This is the image of the spreadsheet that Im testing on

Private Sub sendEmail(arrType, arrItem, arrQuantity, arrUnit)

    Dim i      As Integer
    Dim objOutlook As Object
    Set objOutlook = CreateObject("outlook.application"
    Dim ws     As Worksheet
    Dim strSubject As String
    Dim strBody As String
    Dim strType As String
    Dim strItem As String
    Dim strQuantity As String
    Dim strUnit As String
    Dim strTable As String
    Dim strHTML As String
    Set ws = ThisWorkbook.Worksheets("Data")
    
    strSubject = "Testing"
    strBody = "<html>"
    strBody = strBody & "Please see the order details below for your reference:<br><br>"
    strTable = "<br><table border = 2><tbody>"
    strTable = strTable & "<tr>"
    strTable = strTable & "<th align = center> Type</th>"
    strTable = strTable & "<th align = center> Item</th>"
    strTable = strTable & "<th align = center> Quantity</th>"
    strTable = strTable & "<th align = center> unit</th>"
    strTable = strTable & "<tr/>"
    
    For i = 4 To UBound(arrType)
        strType = arrType(i)
        strItem = arrItem(i)
        strQuantity = arrQuantity(i)
        strUnit = arrUnit(i)
        
        strTable = strTable & "<tr><td>" & strType & "</td>"
        strTable = strTable & "<td>" & strItem & "</td>"
        strTable = strTable & "<td>" & strQuantity & "</td>"
        strTable = strTable & "<td>" & strUnit & "</td></tr>"
    Next
    strTable = strTable & "</tbody></table><br>"
    strHTML = strBody & strTable & "</html>"
    
    If MsgBox("Are you sure you want to submit? ", vbYesNo, "Submit Confirmation") = vbYes Then
        Dim objEmail As Object
        Set objEmail = objOutlook.CreateItem(0)
        With objEmail
            .To = ""
            .Subject = "testing"
            .HTMLBody = strHTML
            .Display
            .Send
        End With
        MsgBox "Thanks for the order. Your order details are sent successfully.", vbxOKOnly, "Operation Successful"
    Else
        Exit Sub
    End If
End Sub


Private Sub itemStored(arrType, arrItem, arrQuantity, arrUnit)

    Set ws = ThisWorkbook.Worksheets("Data")
    
    Dim i      As Long
    Dim cb     As CheckBox
    
    For Each cb In CheckBoxes
        If cb.Value = 1 Then
            arrType(i) = ws.Cells(i + 4, "I").Value
            arrItem(i) = ws.Cells(i + 4, "I").Value
            arrQuantity(i) = ws.Cells(i + 4, "I").Value
            arrUnit(i) = ws.Cells(i + 4, "I").Value
            i = i + 1
        End If
    Next
    
End Sub

Private Sub cmdbtnShow_Click()
    OrderForm.Show
End Sub

Private Sub CommandButton2_Click()
    Dim arrType() As Variant
    Dim arrItem() As Variant
    Dim arrQuantity As Integer
    Dim arrUnit As String

    Call itemStored(arrType, arrItem, arrQuantity, arrUnit)
    Call sendEmail(arrType, arrItem, arrQuantity, arrUnit)
End Sub

When the checkboxes are selected, items on the left hand side will send an email. I tried making arrType and arrItem correspond to sendEmail.


Solution

  • Try this out - I think it's easier to use a collection of arrays to hold information from the selected rows.

    Option Explicit
    
    Private Sub sendEmail(colItems As Collection)
    
        Dim objOutlook As Object, arr, ws As Worksheet, objEmail As Object
        Dim i As Integer, strSubject As String, strBody As String, strTable As String, strHTML As String
        
        strSubject = "Testing"
        strBody = "<html>"
        strBody = strBody & "Please see the order details below for your reference:<br><br>"
        strTable = "<table border=2><tbody>"
        strTable = strTable & "<tr><th align='center'>Type</th>"
        strTable = strTable & "<th align='center'>Item</th>"
        strTable = strTable & "<th align='center'>Quantity</th>"
        strTable = strTable & "<th align='center'>unit</th></tr>"
        For Each arr In colItems 'loop arrays in collection
            strTable = strTable & "<tr><td>" & Join(arr, "</td><td>") & "</td></tr>"
        Next arr
        strTable = strTable & "</tbody></table>"
        strHTML = strBody & strTable & "<br></html>"
        
        If MsgBox("Are you sure you want to submit? ", vbYesNo, "Submit Confirmation") = vbYes Then
            
            Set objOutlook = CreateObject("outlook.application")
            Set objEmail = objOutlook.CreateItem(0)
            With objEmail
                .To = ""
                .Subject = strSubject
                .HTMLBody = strHTML
                .Display
                '.send
            End With
            MsgBox "Thanks for the order. Your order details are sent successfully.", _
                   vbOKOnly, "Operation Successful"
        Else
            Exit Sub
        End If
    End Sub
    
    'collect information from each row associated with a checked ActiveX checkbox...
    Private Function selectedItems() As Collection
        Dim obj As Object, ws As Worksheet
        Set selectedItems = New Collection
        Set ws = ThisWorkbook.Worksheets("Data")
        For Each obj In ws.OLEObjects   'loop all controls on the sheet
            If TypeName(obj.Object) = "CheckBox" Then 'is a checkbox?
                If obj.Object.Value = True Then       'checkbox is checked?
                    With obj.TopLeftCell.EntireRow    'the row the checkbox is on
                        'add array of row values to the collection
                        selectedItems.Add Array(.Columns("D").Value, .Columns("E").Value, _
                                                .Columns("F").Value, .Columns("G").Value)
                    End With
                End If 'checked
            End If
        Next obj
    End Function
    
    Private Sub CommandButton2_Click()
        Dim selItems As Collection
        Set selItems = selectedItems() 'returns a Collection of arrays
        If selItems.Count > 0 Then
            sendEmail selItems
        Else
            MsgBox "No items selected"
        End If
    End Sub