VBA电子邮件特定的单元格到其他单元格中定义的电子邮件地址

时间:2018-09-21 12:30:31

标签: excel vba excel-vba

我刚接触VBA脚本几天,现在才开始工作,而我目前正在努力完成当前的脚本。

目前,它会检查是否有空单元格,提示您通知它们为空,然后将它们涂成红色,如果您在中输入Yes或No,则假定将电子邮件中已定义的单元格发送到另一个单元格中的电子邮件列表中电子邮件旁边的单元格。

问题:我如何使该脚本正常工作?,我需要它通过电子邮件发送B列中的所有电子邮件,但仅通过电子邮件发送先前定义的选择(D2至F40)

代码:

Sub SendSelectedCells()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range

    'Select Cells To Send
    ActiveSheet.Range("D2:F40").Select

    'Start Outlook
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")

    On Error GoTo cleanup

    'Define Emails to send to
    For Each cell In Columns([B]).Cells.SpecialCells(x1CellTypeConstants)

        If cell.Value Like "?*@?*.?*" And _
        LCase(Cells(cell.Row, [C]).Value) = "yes" Then

            LCase (Cells(cell.Row, [G]).Value) <> "send"

            'Email
            Set OutMail = OutApp.CreateItem(0)

            On Error Resume Next
            With OutMail
                .To = cell.Value
                .Subject = "Certificate of Confirmity"
                .Body = "Dear Sir/Madam,"
                .Send
            End With
            On Error GoTo 0

            'Tidy up
            Set OutMail = Nothing
        End If

    Next cell

cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True

End Sub

0 个答案:

没有答案