使用 Excel VBA 從表發送電子郵件

Question

我有一個表格中的電子郵件列表，我想向這些人發送電子郵件。

目前，我的代碼只引用了一個存儲多封電子郵件的單元格。

emailItem.To = Range("A2").Value
emailItem.CC = Range("B2").Value

如何引用表數組，以便當我從分發列表中添加或刪除某人時，它變為“動態”。

這是我的桌子的樣子：

這是我正在使用的代碼：

Option Explicit

Sub Send_Email_With_Attachment()    
    Dim emailApplication As Object
    Dim emailItem As Object

    Set emailApplication = CreateObject("Outlook.Application")
    Set emailItem = emailApplication.CreateItem(0)

    'Date Update in Subject Line

    Dim lastSunday As Date
    lastSunday = DateAdd("d", 1 - Weekday(Now), Now)

    'Now build the email.    
    emailItem.To = Range("A2").Value    
    emailItem.CC = Range("B2").Value    

    emailItem.Subject = "Training Report  - " & Format(lastSunday, "dd-MM-yyyy")    
    emailItem.Body = "Dear All" & vbCrLf & vbCrLf & "Please find attached the Weekly  Training report." & vbCrLf & vbCrLf & "Kind Regards,"

    ' Attach any file from computer


    'Send the email
    emailItem.Display 
End Sub

Answer 1

代替

emailItem.To = Range("A2").Value    
emailItem.CC = Range("B2").Value    

利用

Dim EmailTable As ListObject  ' define your email table in the sheet
Set EmailTable = ThisWorkbook.Worksheets("Sheet1").ListObjects("Email2")

emailItem.To = Join(Application.Transpose(EmailTable.ListColumns("To").DataBodyRange.Value2), ";")    
emailItem.CC = Join(Application.Transpose(EmailTable.ListColumns("CC").DataBodyRange.Value2), ";")    

請注意， Email2是您的表的名稱，而Sheet1需要是工作表的名稱。 Transpose將從列中生成一個一維數組，我們可以將其Join到一個由;分隔的字符串中。

Answer 2

這是我用來生成電子郵件的代碼。

該代碼僅在“收件人和抄送”都在同一個表中時才有效。

該代碼僅適用於您所在的活動表。

該代碼還引用了過去的日期，可以很容易地修改。 更改這部分代碼："("d", 1 - Weekday(Now), Now)" 以滿足您的需要。

Option Explicit

Sub Send_Email_With_Attachment() 將 OutApp 調暗為 Object，OutMail 作為 Object 將 emailTo 作為字符串調暗，emailCC 作為字符串調暗 lastSunday 作為日期調暗 Z4A8A08F09D37B73B5333566

lastSunday = DateAdd("d", 1 - Weekday(Now), Now)

emailTo = WorksheetFunction.TextJoin(";", True, ActiveSheet.Range("Email2[To]"))
emailCC = WorksheetFunction.TextJoin(";", True, ActiveSheet.Range("Email2[CC]"))
 
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .To = emailTo
        .CC = emailCC
        .Subject = "Report  - " & Format(lastSunday, "dd-MM-yyyy")
        .Body = "Dear All" & vbCrLf & vbCrLf & _
        "Please find attached the Weekly report." & vbCrLf & vbCrLf & "Kind Regards,"
        '.Attachments.Add ""
        .Send
    End With

結束子