Question

我已经设置了一个Userform，它将数据保存到“事件详细信息”数据表中，并将数据临时保存到名为“电子邮件表单”的工作表中，并像表单一样布局，以便将“电子邮件表单”复制到MS Outlook电子邮件。

这非常有效，并且根据当前的编码，我提供了一封电子邮件至 1收件人， CC'd 发送给另一封邮件，但我需要发送相同的电子邮件至多个收件人。我创建了另一个名为“电子邮件收件人列表（同一工作簿）”的工作表，因为我希望它可以根据需要轻松更新列表（没有用户可以在VBA中编辑硬编码）。列A具有TO收件人列表，列B具有CC收件人列表。

我搜索并查看了多个视频和网站，但我无法解决如何从“电子邮件收件人列表”表中提取相应列表并填充Outlook电子邮件，而不会影响现有操作。我不想让用户点击宏按钮，因为代码会打开Outlook电子邮件。

这是我现有的代码：

Sub log_send_reset()
'THIS OPENS OUTLOOK WITH DETAILS OF FORM

'WORKS with "Email Form"
Dim SecIncNo As String

'This bit emails the current worksheet in the body of an email as HTML
'#If 0 Then
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object

Set rng = Nothing
On Error Resume Next

Set rng = Sheets("Email Form").Range("A1:AB119")
On Error GoTo 0

With Application
    .EnableEvents = False
    .ScreenUpdating = True 'ShyButterfly set this to TRUE (it was false)
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail

'This bit tells it where to send the email to, what the subject line is  etc

 .to = "246abc@company.com"

 .CC = "rep3@company2.com"
 .BCC = ""
 .Subject = Range("H6").value & " - " & "SAC" & Range("G12").value & " - " & Range("G14").value & " - " & Range("H8").value
    .HTMLBody = RangetoHTML(rng)
    'Shybutterfly changed from.Send to .Display to see what it does
    .Display
'or use .Display if you want to edit / add text before sending

End With
On Error GoTo 0

With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing


ThisWorkbook.Save

'ThisWorkbook.Close

'Application.Quit


End Sub

我很感激你的帮助。

Answer 1

这将为您创建收件人列表。

EmailTo = getRecipients（1）

EmailCC = getRecipients（2）

- (void)viewDidLoad {
    [super viewDidLoad];

    self.nameBox.delegate = self;
    [_nameBox setUsesDataSource:NO];
    NSString *path = [[NSBundle mainBundle] pathForResource:@"People" ofType:@"plist"];
    NSMutableArray *contents = [NSMutableArray arrayWithContentsOfFile:path];
    for (int i = 0; i < [contents count]; i++){
        [_nameBox addItemWithObjectValue:[[contents objectAtIndex:i] objectForKey:@"Name"]];
    }
}

我没有看到你在哪里得到一个未定义的变量错误。如果getRecipients在私有模块中，则会得到子或函数未定义的错误。

我重构了我们的代码。请在代码模块中单独运行并运行ComposeEmail。

    Option Explicit
    Public Sub ComposeEmail()

        ToggleEvents False

        Dim EmailTo As String, CC As String, BCC As String, Subject As String, HTMLBody As String, ShowEmail As Boolean
        Dim rng As Range

        ToggleEvents False

        Set rng = Sheets("Email Form").Range("A1:AB119")

        EmailTo = getRecipients(1)
        CC = getRecipients(2)
        'BCC = getRecipients(2)
        Subject = Range("H6").Value & " - " & "SAC" & Range("G12").Value & " - " & Range("G14").Value & " - " & Range("H8").Value
        HTMLBody = RangetoHTML2(rng)
        ShowEmail = True

        SendMail EmailTo, CC, BCC, Subject, HTMLBody, ShowEmail

        ' ThisWorkbook.Close True 'This Line save and Closes the workbook

        ToggleEvents True

    End Sub

    Function getRecipients(vColumn As Variant) As String
        Dim rListColumn As Range
        Dim c As Range
        Dim s As String
        With Worksheets("Email Recipient List")

            Set rListColumn = .Range(.Cells(2, vColumn), .Cells(Rows.Count, vColumn).End(xlUp))

            For Each c In rListColumn
                s = s & c.Text & ";"
            Next

            getRecipients = Left(s, Len(s) - 1)
        End With

    End Function

    Public Sub SendMail(EmailTo As String, CC As String, BCC As String, Subject As String, HTMLBody As String, ShowEmail As Boolean)
        Dim OutApp As Object
        Dim OutMail As Object
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .to = EmailTo
            .CC = CC
            .BCC = BCC
            .Subject = Subject
            .HTMLBody = HTMLBody

            If ShowEmail Then
                .Display
            Else
                .Send
            End If

        End With

        Set OutMail = Nothing
        Set OutApp = Nothing
        Exit Sub
    EmailCouldNotBeCreated:
        MsgBox "Email could not be created", vbCritical, "Error in Sub SendMail"
    End Sub

    Sub ToggleEvents(bEnableEvents As Boolean)
        With Application
            .EnableEvents = bEnableEvents
            .ScreenUpdating = bEnableEvents
        End With
    End Sub


    ' https://msdn.microsoft.com/en-us/library/ff519602%28v=office.11%29.aspx?f=255&MSPPError=-2147217396

    Function RangetoHTML2(rng As Range)
    ' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, and Outlook 2010.
        Dim fso As Object
        Dim ts As Object
        Dim TempFile As String
        Dim TempWB As Workbook

        TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

        ' Copy the range and create a workbook to receive the data.
        rng.Copy
        Set TempWB = Workbooks.Add(1)
        With TempWB.Sheets(1)
            .Cells(1).PasteSpecial Paste:=8
            .Cells(1).PasteSpecial xlPasteValues, , False, False
            .Cells(1).PasteSpecial xlPasteFormats, , False, False
            .Cells(1).Select
            Application.CutCopyMode = False
            On Error Resume Next
            .DrawingObjects.Visible = True
            .DrawingObjects.Delete
            On Error GoTo 0
        End With

        ' Publish the sheet to an .htm file.
        With TempWB.PublishObjects.Add( _
             SourceType:=xlSourceRange, _
             Filename:=TempFile, _
             Sheet:=TempWB.Sheets(1).Name, _
             Source:=TempWB.Sheets(1).UsedRange.Address, _
             HtmlType:=xlHtmlStatic)
            .Publish (True)
        End With

        ' Read all data from the .htm file into the RangetoHTML subroutine.
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
        RangetoHTML = ts.ReadAll
        ts.Close
        RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                              "align=left x:publishsource=")

        ' Close TempWB.
        TempWB.Close savechanges:=False

        ' Delete the htm file.
        Kill TempFile

        Set ts = Nothing
        Set fso = Nothing
        Set TempWB = Nothing
    End Function

Answer 2

为每个收件人调用MailItem.Recipients.Add（它返回Recipient对象，将其Recipient.Type属性设置为适当的olTo / olCC / olBCC），将To / CC / BCC属性设置为＆＃34; ;＆＃34;分开的地址列表。

Excel 2013 VBA - 设置电子邮件收件人列表（TO和CC）填充Oulook电子邮件

2 个答案: