[英]VBA send emails from Excel
我在 Excel 中有一個簡單的表。 它的構建如下:
|Information on food|
|date: April 28th, 2021|
|Person|Email|Apples|Bananas|Bread|
|------|-----|------|-------|-----|
|Person_A|person_A@mailme.com|3|8|9|
|Person_B|person_B@mailme.com|10|59|11|
|Person _C|person_C@maime.com|98|12|20|
表中還有一個日期字段。 對於測試,這可以設置為今天的日期。 基於這些信息,我正在尋找一個 VBA 代碼,它為每個列出的人准備一個 email 並告訴他們他們在特定日期吃了什么。 所以我需要訪問表中的幾個字段,同時循環瀏覽電子郵件。 然后我想 VBA 打開 Outlook 並准備電子郵件。 理想情況下還沒有發送它們,所以我可以在發送郵件之前進行最后的查看。 可以通過范圍等專門訪問某些單元格。如果這很重要,我正在使用 Excel/Outlook 2016。 問題是如何在 VBA 中實現這一點?
假設數據是一個命名表,並且標題/日期在表的角落上方,如您的示例所示。 此外,表的所有行都有有效數據。 電子郵件已准備好並顯示但未發送(除非您更改顯示的代碼)。
Option Explicit
Sub EmailMenu()
Const TBL_NAME = "Table1"
Const CSS = "body{font:12px Verdana};h1{font:14px Verdana Bold};"
Dim emails As Object, k
Set emails = CreateObject("Scripting.Dictionary")
Dim ws As Worksheet, rng As Range
Dim sName As String, sAddress As String
Dim r As Long, c As Integer, s As String, msg As String
Dim sTitle As String, sDate As String
Set ws = ThisWorkbook.Sheets("Sheet1")
Set rng = ws.ListObjects(TBL_NAME).Range
sTitle = rng.Cells(-1, 1)
sDate = rng.Cells(0, 1)
' prepare emails
For r = 2 To rng.Rows.Count
sName = rng.Cells(r, 1)
sAddress = rng.Cells(r, 2)
If InStr(sAddress, "@") = 0 Then
MsgBox "Invalid Email: '" & sAddress & "'", vbCritical, "Error Row " & r
Exit Sub
End If
s = "<style>" & CSS & "</style><h1>" & sDate & "<br>" & sName & "</h1>"
s = s & "<table border=""1"" cellspacing=""0"" cellpadding=""5"">" & _
"<tr bgcolor=""#ddddff""><th>Item</th><th>Qu.</th></tr>"
For c = 3 To rng.Columns.Count
s = s & "<tr><td>" & rng.Cells(1, c) & _
"</td><td>" & rng.Cells(r, c) & _
"</td></tr>" & vbCrLf
Next
s = s & "</table>"
' add to dictonary
emails.Add sAddress, Array(sName, sDate, s)
Next
' confirm
msg = "Do you want to send " & emails.Count & " emails ?"
If MsgBox(msg, vbYesNo) = vbNo Then Exit Sub
' send emails
Dim oApp As Object, oMail As Object, ar
Set oApp = CreateObject("Outlook.Application")
For Each k In emails.keys
ar = emails(k)
Set oMail = oApp.CreateItem(0)
With oMail
.To = CStr(k)
'.CC = "email@test.com"
.Subject = sTitle
.HTMLBody = ar(2)
.display ' or .send
End With
Next
oApp.Quit
End Sub
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.