Question

我有三列：A）企业B）与企业匹配的电子邮件地址C）是或否

如果C列中为是，我想向B列中的电子邮件地址发送一条消息。

这就是我所拥有的。什么都没发生。

Sub Test2()

    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim cell As Range

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

    On Error GoTo cleanup
    For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" And _
          LCase(Cells(cell.Row, "C").Value) = "yes" _
          And LCase(Cells(cell.Row, "D").Value) <> "send" Then

            Set OutMail = OutApp.CreateItem(olMailItem)

            On Error Resume Next
            With OutMail
                .To = cell.Value
                .Subject = "Reminder"
                .Body = "Dear " & Cells(cell.Row, "A").Value _
                  & vbNewLine & vbNewLine & _
                  "Please contact us to discuss bringing " & _
                  "your account up to date."
                Attachments.Add ("\\C:\test.pdf")
                .Send  '
            End With
            On Error GoTo 0
            Cells(cell.Row, "D").Value = "send"
            Set OutMail = Nothing
        End If
    Next cell

cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub

Answer 1

下面的代码将循环第2行到UsedRange中的最后一行，并确保A，B和C列不为空，并检查以确保D列为空，该代码用作标志显示以前是否已发送过电子邮件。

我已在代码中添加了Regex验证功能以验证电子邮件地址。

Sub LoopThroughRange_SendEmail()
Dim OutApp As Object: Set OutApp = CreateObject("Outlook.Application")
Dim OutMail As Object: Set OutMail = OutApp.CreateItem(0)
Dim oRegEx As Object
Set oRegEx = CreateObject("VBScript.RegExp")
Dim i As Long
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
'declare and set the worksheet you are working with

For i = 2 To ws.UsedRange.Rows.Count
'loop from Row 2 To Last Row in UsedRange
    If ws.Cells(i, "A").Value <> "" And ws.Cells(i, "B").Value <> "" And ws.Cells(i, "C").Value = "Yes" And ws.Cells(i, "D").Value = "" Then
    ' make sure that Columns A, B & C are not empty and D is empty (which we will use as a flag to show that the email did get sent.
        If ValidEmail(ws.Cells(i, "B").Value, oRegEx) Then
            With OutMail
                .To = ws.Cells(i, "B").Value
                .CC = ""
                .BCC = ""
                .Subject = "Reminder"
                .Body = "Dear " & Cells(cell.Row, "A").Value _
                          & vbNewLine & vbNewLine & _
                            "Please contact us to discuss bringing " & _
                            "your account up to date."
                .Attachments.Add ("\\C:\test.pdf")
                .Display '.Send
            End With
            ws.Cells(i, "D").Value = "Sent @ " & Format(Now(), "yyyy-MM-dd hh:mm:ss")
        Else
            ws.Cells(i, "D").Value = "Email not valid"
        End If
    End If
End Sub

Public Function ValidEmail(pAddress As String, ByRef oRegEx As Object) As Boolean
    With oRegEx
        .Pattern = "^(([a-zA-Z0-9_\-\.\']+)@((\[[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.)|(([a-zA-Z0-9\-]+\.)+))([a-zA-Z]{2,4}|[0-9]{1,3})(\]?)(\s*;\s*|\s*$))+$" 'pattern for multiple email addresses included
        ValidEmail = .test(pAddress)
    End With
End Function

当列中的日期等于或小于今天的日期时，如何使用Excel发送电子邮件？

1 个答案: