excel 带有for循环的电子邮件

qni6mghb 于 2023-01-21 发布在其他

关注(0)|答案(2)|浏览(164)

我使用的脚本将只发送一封电子邮件，而不是200多封电子邮件。

Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Dim LastRow As Integer

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

    LastRow = Worksheets("DRIVERS").Cells(Rows.Count, 1).End(xlUp).Row

    On Error GoTo cleanup
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    For r = 2 To LastRow
        With OutMail
            '.To = Worksheets("DRIVERS").Range("G" & r).Value
            If Worksheets("DRIVERS").Range("F" & r).Value = "X" Then
                .To = "me@me.me" ← Changed for obvious reasons <3
            Else
                .To = Worksheets("DRIVERS").Range("AL" & r).Value
            End If
            .Subject = "EDN Roster"
            .HTMLBody = "Dear " & Worksheets("DRIVERS").Range("D" & r).Value & "<br /><br />" & _
                    "Please find your Roster below!<br /><br /><b>This Week:</b><br />" & _
                    "<table border=1><tr><th></th><th>Monday</th><th>Tuesday</th><th>Wednesday</th><th>Thursday</th><th>Friday</th><th>Saturday</th><th>Sunday</th></tr>" & _
                    "<tr><td>Shift</td><td>" & Worksheets("DRIVERS").Range("H" & r).Value & "</td><td>" & Worksheets("DRIVERS").Range("I" & r).Value & "</td><td>" & Worksheets("DRIVERS").Range("J" & r).Value & "</td><td>" & Worksheets("DRIVERS").Range("K" & r).Value & "</td><td>" & Worksheets("DRIVERS").Range("L" & r).Value & "</td><td>" & Worksheets("DRIVERS").Range("M" & r).Value & "</td><td>" & Worksheets("DRIVERS").Range("N" & r).Value & "</td>" & _
                    "<tr><td>Sign On</td><td>" & Worksheets("DRIVERS").Range("W" & r).Value & "</td><td>" & Worksheets("DRIVERS").Range("Y" & r).Value & "</td><td>" & Worksheets("DRIVERS").Range("AA" & r).Value & "</td><td>" & Worksheets("DRIVERS").Range("AC" & r).Value & "</td><td>" & Worksheets("DRIVERS").Range("AE" & r).Value & "</td><td>" & Worksheets("DRIVERS").Range("AG" & r).Value & "</td><td>" & Worksheets("DRIVERS").Range("AI" & r).Value & "</td>" & _
                    "<tr><td>Sign Off</td><td>" & Worksheets("DRIVERS").Range("X" & r).Value & "</td><td>" & Worksheets("DRIVERS").Range("Z" & r).Value & "</td><td>" & Worksheets("DRIVERS").Range("AB" & r).Value & "</td><td>" & Worksheets("DRIVERS").Range("AD" & r).Value & "</td><td>" & Worksheets("DRIVERS").Range("AF" & r).Value & "</td><td>" & Worksheets("DRIVERS").Range("AH" & r).Value & "</td><td>" & Worksheets("DRIVERS").Range("AJ" & r).Value & "</td>" & _
                    "</table><br /><br />" & _
                    "<b>Next Week:</b><br />" & _
                    "<table border=1><tr><th></th><th>Monday</th><th>Tuesday</th><th>Wednesday</th><th>Thursday</th><th>Friday</th><th>Saturday</th><th>Sunday</th></tr>" & _
                    "<tr><td>Shift</td><td>" & Worksheets("DRIVERS").Range("O" & r).Value & "</td><td>" & Worksheets("DRIVERS").Range("P" & r).Value & "</td><td>" & Worksheets("DRIVERS").Range("Q" & r).Value & "</td><td>" & Worksheets("DRIVERS").Range("R" & r).Value & "</td><td>" & Worksheets("DRIVERS").Range("S" & r).Value & "</td><td>" & Worksheets("DRIVERS").Range("T" & r).Value & "</td><td>" & Worksheets("DRIVERS").Range("U" & r).Value & "</td>" & _
                    "<tr><td>Sign On</td><td>" & Worksheets("DRIVERS").Range("AN" & r).Value & "</td><td>" & Worksheets("DRIVERS").Range("AP" & r).Value & "</td><td>" & Worksheets("DRIVERS").Range("AR" & r).Value & "</td><td>" & Worksheets("DRIVERS").Range("AT" & r).Value & "</td><td>" & Worksheets("DRIVERS").Range("AV" & r).Value & "</td><td>" & Worksheets("DRIVERS").Range("AX" & r).Value & "</td><td>" & Worksheets("DRIVERS").Range("AZ" & r).Value & "</td>" & _
                    "<tr><td>Sign Off</td><td>" & Worksheets("DRIVERS").Range("AO" & r).Value & "</td><td>" & Worksheets("DRIVERS").Range("AQ" & r).Value & "</td><td>" & Worksheets("DRIVERS").Range("AS" & r).Value & "</td><td>" & Worksheets("DRIVERS").Range("AU" & r).Value & "</td><td>" & Worksheets("DRIVERS").Range("AW" & r).Value & "</td><td>" & Worksheets("DRIVERS").Range("AY" & r).Value & "</td><td>" & Worksheets("DRIVERS").Range("BA" & r).Value & "</td>" & _
                    "</table><br /><br />" & _
                    "This email is an automated notification, which is unable to receive replies."
            .Send  'Display
        End With
    Next
    On Error GoTo 0
    Set OutMail = Nothing

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

消息工作，如果我使用.显示它循环通过所有员工的，并更改所有必要的信息.
我看到2016年的一个线程，CreateObject必须在For循环之外，这并没有改变它。

excel

来源：https://stackoverflow.com/questions/75179585/e-mail-with-a-for-loop

2条答案

按热度按时间

sf6xfgos1#

对于那些沿着来说，Set OutMail = OutApp.CreateItem(0)必须在for循环中设置！

赞(0）回复(0）举报 2023-01-21

eh57zj3b2#

我知道你已经解决了你的问题，但我建议使用一个单独的潜艇来发送电子邮件和收集信息。我在网上找到了一个，并适应了我的需要：

Sub SendEmail(Optional ToAddresses As String, Optional CcAddresses As String, _
Optional BccAddresses As String, Optional Subject As String, _
Optional Body As String, Optional AttachFiles As Variant = False, Optional AutoSend As Boolean = False, _
Optional SendFromAddress As String)
'Adapted from https://www.rondebruin.nl/win/s1/outlook/bmail4.htm

    Dim OutApp As Object
    Dim OutMail As Object
    
    'Current application, where applicable;
    On Error GoTo Err
    Set OutApp = GetObject(, "Outlook.Application")
NoErr:
    On Error GoTo 0
    Set OutMail = OutApp.CreateItem(0)

    With OutMail
    
    'Basic Text properties
        .To = ToAddresses
        .CC = CcAddresses
        .Bcc = BccAddresses
        .Subject = Subject
    '---------------------
            
    'Body; HTML or plain text
        If Body Like "*<br>*" Then
            .HtmlBody = Body
        Else
            .Body = Body
        End If
     '---------------------
            
    'Attachments:
        If Not AttachFiles = False Then
            If IsArray(AttachFiles) Then
                For x = LBound(AttachFiles) To UBound(AttachFiles)
                    .Attachments.Add (AttachFiles(x))
                Next
            Else
                .Attachments.Add (AttachFiles)
            End If
        End If
    '---------------------
            
    'Sender Address
        If Len(SendFromAddress) > 0 Then
            For a = 1 To OutApp.Session.Accounts.Count
                If LCase(OutApp.Session.Accounts.Item(a)) Like LCase(SendFromAddress) Then
                    .sendusingaccount = OutApp.Session.Accounts.Item(a)
                    SendFromAddress = ""
                    Exit For
                End If
            Next
            If Len(SendFromAddress) > 0 Then .SentOnBehalfOfName = SendFromAddress
        End If
    '---------------------
            
    'Send or display:
        If AutoSend = True Then
            .Send
        Else
            .Display
        End If
    '---------------------
            
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
Exit Sub
Err:
        If Err.Number = 429 Then
            Set OutApp = CreateObject("Outlook.application")
            GoTo NoErr
        End If
        On Error GoTo 0
        Err.Raise (Err.Number)
End Sub

那么在你的例子中，你的另一个循环只需要把HTMLEbody组装成一个字符串变量，那么

SendEmail ToAddresses:="me@me.me", Subject:="EDN Roster", Body:=strBody, AutoSend:=True

这使得代码更易于阅读和维护，并且您可以在不同的宏中重用email sub。

赞(0）回复(0）举报 2023-01-21

我来回答

excel 带有for循环的电子邮件

2条答案

相关问题

热门标签

最新问答