Excel在同一列中向所有人發送電子郵件，只需要向特定單元格中的所有人發送電子郵件。 怎么樣？

Question

我正在創建一個電子表格，該電子表格將在報告到期前30、15和7天通過電子郵件發送給主管。 一切正常，除了它正在向L列中的每個人發送電子郵件，而不是向L列中的指定人員發送電子郵件。

請幫忙。 我已經復制並粘貼了以下代碼。

Public Sub GetDates()
    Dim rw As Integer
    Dim subj As String
    rw = 2

    With ActiveSheet

       Do Until .Range("A" & rw) = ""
            If .Range("M" & rw) = "" Then
                If DateAdd("D", 30, Date) = .Range("G" & rw) Then
                    Call SendEmail(Range("A" & rw), Range("B" & rw), 30, Range("L" & rw), False)
                ElseIf DateAdd("D", 15, Date) = .Range("G" & rw) Then
                    Call SendEmail(Range("A" & rw), Range("B" & rw), 15, Range("L" & rw), False)
                ElseIf DateAdd("D", 7, Date) = .Range("G" & rw) Then
                    Call SendEmail(Range("A" & rw), Range("B" & rw), 7, Range("L" & rw), False)
                End If
            End If

            If Day(Date) = 1 And .Range("G" & rw) < Date And .Range("M" & rw) = "" Then
                subj = subj & .Range("A" & rw) & ", " & .Range("B" & rw) & "--" & .Range("C" & rw) & " Report Past Due" & vbCrLf
            End If
            rw = rw + 1

        Loop

        If subj <> "" Then
            Call SendEmail(subj, "", 0, "supervisor@company.com", True)
            Call SendEmail(subj, "", 0, "aothersupervisor@company.com", True)
        End If
    End With

End Sub

Public Sub SendEmail(lName As String, fName As String, nDays As Integer, sTo As String, LastEmail As Boolean)

    Dim iMsg As Object
    Dim iConf As Object
    Dim cell As Range
    Dim Flds As Variant



    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")

     iConf.Load -1    ' CDO Source Defaults
        Set Flds = iConf.Fields
        With Flds
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") _
                           = "server"
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
            .Update
        End With

For Each cell In ActiveSheet.Columns("L").Cells
        If cell.Value Like "?*@?*.?*" Then
            Set iMsg = CreateObject("CDO.Message")
    With iMsg
        Set .Configuration = iConf
        .to = cell.Value
        .CC = ""
        .BCC = ""
        .From = """Report Due"" <donotreply@company.com>"
        .Subject = "Report Due"
        .HTMLBody = lName & ", " & fName & "  <a href='http://www.website.com'>Probation Report</a> / <a href='http://www.website.com'>IDP Report</a> Due in " & nDays & " days"
        .Send
            End With
            Set iMsg = Nothing
    End If
Next cell

With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With

End Sub

Answer 1

在SendEmail子例程中，您永遠不會使用L列電子郵件參數sTo ，而例程會遍歷L列中的每個單元格：

For Each cell In ActiveSheet.Columns("L").Cells
     ...
Next cell

刪除此For循環並使用sTo ：

If sTo Like "?*@?*.?*" Then
    Set iMsg = CreateObject("CDO.Message")
    With iMsg
        Set .Configuration = iConf
        .to = sTo
        .CC = ""
        .BCC = ""
        .From = """Report Due"" <donotreply@company.com>"
        .Subject = "Report Due"
        .HTMLBody = lName & ", " & fName & "  <a href='http://www.website.com'>Probation Report</a> / <a href='http://www.website.com'>IDP Report</a> Due in " & nDays & " days"
        .Send
    End With

    Set iMsg = Nothing
End If

---

順便說一句，在您的GetDates子例程中，考慮到要管理的多個條件，請考慮在重復的ElseIf使用Select Case以提高可讀性：

Select Case .Range("G" & rw)

    Case DateAdd("D", 30, Date)
        Call SendEmail(Range("A" & rw), Range("B" & rw), 30, Range("L" & rw), False)

    Case DateAdd("D", 15, Date)
        Call SendEmail(Range("A" & rw), Range("B" & rw), 15, Range("L" & rw), False)

    Case DateAdd("D", 7, Date)
        Call SendEmail(Range("A" & rw), Range("B" & rw), 7, Range("L" & rw), False)

End Select

另外，甚至更短：

Select Case .Range("G" & rw) - Date

    Case 7, 15, 30
        Call SendEmail(Range("A" & rw), Range("B" & rw), _
                       .Range("G" & rw) - Date, Range("L" & rw), False)

End Select