在Excel中过滤和发送电子邮件

Question

我有一个供应商名单，按名称分开，那些延迟交货的和那些准时交货的。

我需要过滤这个电子表格，并发送电子邮件给那些迟到的人。

在此工作表中，有几个来自同一供应商的物料，因此我需要筛选供应商名称，并且有必要将其所有最新物料发送给每个供应商。

信息是可变的。我可以使用"for each“函数吗？

示例电子表格。

​

Answer 1

使用字典保存唯一的电子邮件地址，使用集合保存名称/产品。

Option Explicit
Sub Emailer()

    Dim wb As Workbook, ws As Worksheet
    Dim iLastRow As Long, r As Long
    Dim dict As Object, key, ar, msg As String
    Set dict = CreateObject("Scripting.Dictionary")
    
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Sheet1")
    iLastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
    ar = ws.Range("A1:E" & iLastRow).Value2 ' array

    ' scan down sheet1 adding late items to dictionary/collection
    For r = 2 To UBound(ar)
        If UCase(ar(r, 2)) = "LATE" Then
            key = Trim(ar(r, 4)) ' email
            If InStr(key, "@") Then
                If Not dict.exists(key) Then
                    dict.Add key, New Collection
                    dict(key).Add ar(r, 1) ' use first item for name
                End If
                dict(key).Add ar(r, 3) ' use 2nd,3rd,4th,etc items for products
            Else
                MsgBox "Invalid Email '" & key & "'", vbExclamation, "Row " & r
            End If
        End If
    Next
    
    ' send emails
    msg = SendEmails(dict)
    MsgBox msg, vbInformation

End Sub

Function SendEmails(ByRef dict) As String

    Const CSS = "<style>p{font:14px Verdana};</style>"

    Dim oApp As Object, oMail As Object, msg As String
    Dim t As String, i As Integer, k
    Set oApp = CreateObject("Outlook.Application")

    For Each k In dict.keys

        ' create table of products
        t = "<table border=""1"" cellspacing=""0"" cellpadding=""5""><tr><th>Item</th><th>Product</th></tr>"
        For i = 2 To dict(k).Count
           t = t & "<tr align=""center""><td>" & i - 1 & "</td><td>" & dict(k).Item(i) & " </td></tr>"
        Next
        t = t & "</table>"
        
        Set oMail = oApp.CreateItem(0)
        With oMail
            .To = CStr(k)
            .Subject = "Late Products"
            .HTMLBody = CSS & "<p>Hi " & dict(k).Item(1) & ",<br/>Please note the following are overdue:</p>" & t
            .Display ' or .send
        End With
        msg = msg & vbCrLf & k
    Next
    oApp.Quit
    SendEmails = "Emails sent to :" & msg

End Function