[英]Sending a personalized email from Excel VBA
有人会这么友善并帮助我解决我的问题吗? 我有这个示例表:
我想为每一行发送个性化的电子邮件,这是到目前为止我得到的:
Sub SendEmails()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Columns("A").Cells.SpecialCells(xlCellTypeConstants)
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Project" & Sheets("Sheet1").Range("C").Value ' insert subject from column C
.HTMLBody = "<p>Hello " & Sheets("Sheet1").Range("B").Value &"</p>" & _ ' insert Name from column B
"<p><strong><u>This is a test email</u></strong></p>"
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
我想从电子邮件中的B列和C列获取数据,但是我不知道如何在For Each循环中引用它们以及如何将它们放置在所需的位置。
谢谢
相反,如果使用Range Object
则将要使用的Range Object
的内容存储到矩阵(二维数组)中。现在,您可以通过索引数组来访问“单元格”。 所以B列的内容是myArray(rowNumber,2)
Sub SendEmails()
Dim OutApp As Object
Dim OutMail As Object
Dim rng As Variant
myArray= ThisWorkbook.Sheets("Sheet1").Range("A1:C4")
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
For i = 2 To UBound(myArray)
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = myArray(i, 1)
.Subject = "Project" & myArray(i, 3)
.HTMLBody = "<p>Hello " & myArray(i, 2) & "</p>" & _
"<p><strong><u>This is a test email</u></strong></p>"
.Display
End With
Next i
尝试以下代码:(我在您的代码中更改了3行,并用(X)标记了它们)
Sub SendEmails()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Columns("A").Cells.SpecialCells(xlCellTypeConstants)
i = cell.Row '(X)
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Project" & Sheets("Sheet1").Range("C" & i).Value '(X)
.HTMLBody = "<p>Hello " & Sheets("Sheet1").Range("B" & i).Value & "</p>" & "<p><strong><u>This is a test email</u></strong></p>" '(X)
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
这样尝试。
In column A : Names of the people
In column B : E-mail addresses
In column C:Z : Filenames like this C:\Data\Book2.xls (don't have to be Excel files)
宏将循环遍历“ Sheet1”中的每一行,如果B列中有一个电子邮件地址,而C:Z列中有一个文件名,则它将创建带有此信息的邮件并发送。
Sub Send_Files()
'Working in Excel 2000-2016
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set sh = Sheets("Sheet1")
Set OutApp = CreateObject("Outlook.Application")
For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
'Enter the path/file names in the C:Z column in each row
Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")
If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = cell.Value
.Subject = "Testfile"
.Body = "Hi " & cell.Offset(0, -1).Value
For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell
.Send 'Or use .Display
End With
Set OutMail = Nothing
End If
Next cell
Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.