Question

我是新来的论坛。我对excel中的vba宏有一点问题。可能对您来说并不难，但是我在vba上是全新的。我有两列：具有选择项的“ A”列（例如“是”或“否”）和具有字符串的“ B”列。我想发送一封电子邮件，其中包含“ B”字符串列表，其中所有字符串（逐行）在“ A”中的值为“是”。

Sub Alert()
ActiveSheet.UsedRange.Select
On Error Resume Next
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim list As Object
Dim element As Variant

Application.ScreenUpdating = False

Do While Trim(Cells(cell.Row, "A").Value) = ""
On Error GoTo alertmail
For Each cell In Columns("A").Cells.SpecialCells(xlCellTypeConstants)
 If cell.Value = "yes" Then
  element = Cells(cell.Row, "B").Value
    Set list = CreateObject("System.Collections.ArrayList")
    list.Add element
 End If
Next cell
Loop

alertmail:
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
            .To = "test@abc.com"
            .Subject = "Alert"
            .Body = "Your yes list is" & vbNewLine & PrintArray
            .Display
End With
        On Error GoTo 0
        Set OutMail = Nothing

Exit Sub

Application.ScreenUpdating = True

End Sub

直到现在，我最好的结果是发送一组不同的邮件，每个“ yes”“ A”值都只有一个“ B”字符串（即，如果我有3个“ yes”值，我将获得3封正确的邮件每个字符串都为“ B”。

Answer 1

尝试以下代码：

Sub Alert()
    ActiveSheet.UsedRange.Select
    On Error Resume Next
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Dim list As String
    Dim element As Variant

    Application.ScreenUpdating = False

    Do While Trim(Cells(cell.Row, "A").Value) = ""
    On Error GoTo alertmail
    For Each cell In Columns("A").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value = "yes" Then
            element = Cells(cell.Row, "B").Value
            list = list & vbNewLine & element
        End If
    Next cell
    Loop

alertmail:
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail
                .To = "to@xyz.com"
                .Subject = "Alert"
                .Body = "Your yes list is" & vbNewLine & list
                .Display
    End With
            On Error GoTo 0
            Set OutMail = Nothing

    Exit Sub

    Application.ScreenUpdating = True
End Sub

循环验证后如何发送带有字符串列表的电子邮件

1 个答案: