VBA 自动电子邮件宏

Question

我正在尝试找出一种方法来根据单元格是否为空来自动发送电子邮件提醒。在我的 excel 表中，我有一个列，如果它符合我的条件，它将填充单元格值。目前，我的代码遍历该列中的每一行，如果单元格具有单元格值且不为空，它将为每一行填充一封电子邮件以自动发送。我希望代码找出所有非空白的行，并只发送一封电子邮件，电子邮件的主题或正文从头到尾显示单元格的值。我希望主题行是第一个单元格值到最后一个单元格值。

Sub Email()

    Dim OL As Outlook.Application, Appoint As Outlook.AppointmentItem, ES As Worksheet, _
    r As Long, i As Long, WB As ThisWorkbook, j As Long, k As Long

    Set WB = ThisWorkbook
    Set ES = WB.Sheets("Automatic Email Reminder")
    r = ES.Cells(Rows.Count, 1).End(xlUp).Row
    k = ES.Cells(Rows.Count, 1).End(xlUp).Row
    Set OL = New Outlook.Application

    For i = 4 To r
        If ES.Cells(i, 6) = "" Then 'change this (5 for M&C, 6 for CP, 7 for Objection)

        Else
            Set Appoint = OL.CreateItem(olAppointmentItem)
            With Appoint
                .Subject = ES.Cells(i, 6).Value  
                .RequiredAttendees = "[email protected]"
                .Start = ES.Cells(i, 8).Value
                .Duration = 5
                .ReminderMinutesBeforeStart = 2880
                .Body = ES.Cells(i, 6).Value 
                .MeetingStatus = olMeeting
                .Send
                
            End With
        End If
    Next i
    Set OL = Nothing

End Sub

我已经为每个单元格值编写了一封电子邮件，但我只想为所有单元格值编写一封电子邮件

Answer 1

您需要在循环中创建约会正文字符串，之后您可以发送会议请求，例如：

Dim apptBody as String 
For i = 4 To r
    apptBody = apptBody & ES.Cells(i, 6).Value
Next i

Set Appoint = OL.CreateItem(olAppointmentItem)
With Appoint
 .Subject = ES.Cells(i, 6).Value  
 .RequiredAttendees = "[email protected]"
 .Start = ES.Cells(i, 8).Value
 .Duration = 5
 .ReminderMinutesBeforeStart = 2880
 .Body = apptBody 
 .MeetingStatus = olMeeting
 .Send
End With