选择复选框并将项目发送到电子邮件

问题描述 投票：0回答：1

我在使用 VBA 发送电子邮件时遇到问题。因此，我在工作表中有复选框和项目，并且我想在选中复选框时将项目发送到电子邮件。如果未选择，则不执行任何操作。 我收到此错误，提示“下标超出范围”。我不知道如何修复。 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

选中复选框后，左侧的项目将发送到电子邮件。如果没有，就会发生注意到。我尝试使 arrType 和 arrItem 对应于 sendEmail 但仍然不起作用。

excel vba checkbox outlook
1个回答
0
投票

尝试一下 - 我认为使用数组集合来保存所选行中的信息更容易。

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
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.