Question

我正在尝试从Excel数据表的列中提取电子邮件地址，并让这些电子邮件地址作为基于模板的电子邮件的收件人。

我在下面编写的代码。

Sub Mail_experiment()
   Dim OutApp As Outlook.Application
   Dim OutMail As Outlook.Mailtem
   Set OutApp = CreateObject("Outlook.Application")
   Set = OutMail
OutApp.CreatItemFromTemplate("C:\Users\Name\Documents\Project\PO Accrual Support Email Template.oft")
On Error Resume Next
With OutMail
   .To = "J.Doe@gmail.com"
   .CC = ""
   .BC = ""
   .Subject = ""
   .Save


End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

所有单独的电子邮件将在以后发送，因此.Save。另外，我正尝试从数据表的另一列中提取电子邮件的主题行。

到目前为止，我将如何实现这两个概念？

Answer 1

您应该创建一个函数，该函数根据您的模板返回一个新的MailItem。这样，您就可以单独测试新的MailItem，而不必运行完整的代码。

我想列举我的excel列。如果更改了列顺序，则可以更轻松地引用正确的列和更新代码。

Option Explicit
'Enumeration is by defination the action of establishing the number of something
'I Enumerate my Worksheet Columns to give them a meaningful name that is easy to recognize
Public Enum EmailColumns
    ecEmailAdresses = 1
    ecSubject = 3
End Enum

Public Sub SaveEmails()
    Dim r As Long
    'The With Statement allows you to "perform a series of statements on a specified object without specifying the name of the object multiple times"
    '.Cells(.Rows.Count, ecEmailAdresses).End(xlUp).Row actually refers to ThisWorkbook.Worksheets("Support Emails").Cells(.Rows.Count, ecEmailAdresses).End(xlUp).Row
    With ThisWorkbook.Worksheets("Support Emails")
        '.Cells(): references a cell or range of cells on Worksheets("Support Emails")
        '.Cells(.Rows.Count, ecEmailAdresses): Refrences the last cell in column 1 of the worksheet
        '.End(xlUp): Changes the refererence from the last cell to the first used cell above the last cell in column 3
        '.Cells(.Rows.Count, ecEmailAdresses).End(xlUp).Row: returns the Row number of the last used cell in column 3
        For r = 2 To .Cells(.Rows.Count, ecEmailAdresses).End(xlUp).Row
            getPOAccrualTemplate(MailTo:=.Cells(r, ecEmailAdresses), Subject:=.Cells(r, ecEmailAdresses)).Save
        Next
    End With
End Sub

Public Function getPOAccrualTemplate(MailTo As String, Optional CC As String, Optional BCC As String, Optional Subject As String) As Object
    Const TEMPLATE_PATH As String = "C:\Users\Name\Documents\Project\PO Accrual Support Email Template.oft"
    Dim OutApp As Object, OutMail As Object
    ' CreateObject("Outlook.Application"): Creates an instance of an Outlook Application.
    ' Outlook.Application.CreateItemFromTemplate returns a new MailItem Based on a saved email template
    Set OutMail = CreateObject("Outlook.Application").CreateItemFromTemplate(TEMPLATE_PATH)

    With OutMail
        .To = MailTo
        .CC = CC
        .BCC = BCC
        .Subject = Subject
    End With
    'Returns the new MailItem to the caller of the function
    Set getPOAccrualTemplate = OutMail

End Function

立即窗口测试

'Test getPOAccrualTemplate
' Assign Values to Varaible
MailTo   = "ti@stackoverflow.com"
CC       = "efrenreyes@youdontwantnoneson.com"
BCC      = "alexp@gmail.com"
Subject  = "Who is going to the tournament tonight?"
'Test Variables using "," to insert Tabs between values
?MailTo, CC, BCC, Subject
?MailTo;"-";CC;"-";BCC;"-";Subject
'Pass variables into getPOAccrualTemplate and return a new MailItem based on the template
'variables created in the immediate window are Variant Type
'CStr is used to cast the values to Strings
set OutMail = getPOAccrualTemplate(CStr(MailTo), CStr(CC), CStr(BCC), CStr(Subject))
'Find out what type of object was returned 
?TypeName(OutMail)
'Display the Mail Item
OutMail.Display
'Test Enumerate Columns
Columns(EmailColumns.ecEmailAdresses).Select
Columns(ecSubject).Select
MailTo   = Cells(2, ecEmailAdresses)
CC       = ""
BCC      = ""
Subject  = Cells(2, ecSubject)
'Test the function directly
getPOAccrualTemplate(CStr(MailTo), CStr(CC), CStr(BCC), CStr(Subject)).Display
'Test SaveEmails() Make sure and add a breakpoint 
SaveEmails
?.Cells(.Rows.Count, ecEmailAdresses).End(xlUp).Row

视频教程

这是我最喜欢的VBA教程系列中的两个相关视频：

Answer 2

您应该稍微重构代码。发送电子邮件的宏应该（至少）使用电子邮件地址和参数中的主题：

Sub Mail_experiment(ByVal address As String, ByVal subject As String)
   Dim OutApp As Outlook.Application
   Dim OutMail As Outlook.Mailtem
   Set OutApp = CreateObject("Outlook.Application")
   Set = OutMail
   OutApp.CreatItemFromTemplate("C:\Users\Name\Documents\Project\PO Accrual Support Email Template.oft")
   On Error Resume Next
   With OutMail
   .To = address '<-- use the input here
   .CC = ""
   .BC = ""
   .Subject = subject '<-- use the input here
   .Save
   End With
   On Error GoTo 0
   Set OutMail = Nothing
   Set OutApp = Nothing
End Sub

因此，假设您在A列中有电子邮件地址，在B列中有主题（例如，从1到10），则只需要循环调用该宏：

For j = 1 To 10
    Mail_experiment Range("A" & j), Range("B" & j)
Next j

上面的代码将调用Mail_experiment宏10次，每次传递一个新参数（A1-B1，然后A2-B2等）

从数据表中提取多个电子邮件并基于同一模板制作单独的电子邮件

2 个答案:

立即窗口测试

视频教程