在Outlook中使用VBA在Outlook中生成电子邮件

Question

我需要生成一系列电子邮件，以附加来自特定文件夹的pdf文件。 我是新手，但对我使用的代码有一些了解。 我的问题是我无法控制正在生成的电子邮件数量。 我希望能够生成在目录（行）中有条目的电子邮件的确切数量。

这是代码，任何帮助将不胜感激：

Sub create_email()
    'On Error Resume Next
    'Dim oMail As Outlook.MailItem`
    'Dim num_clients, start_row As Integer`

    Sheets("Control").Activate
    start_row = Range("start_row").row
    num_clients = Range("B100").End(xlUp).row - start_row

    For i = 1 To num_clients
        Set oMail = Outlook.Application.CreateItem(olMailItem)

        'Subject line
        oMail.Subject = Range("J9").Offset(i - 1, 0)

        'Distribution list
        Set RecipTo = oMail.Recipients.Add(Range("K9").Offset(i - 1, 0))
        RecipTo.Type = olTo
        Set RecipCC = oMail.Recipients.Add(Range("L9").Offset(i - 1, 0))
        RecipCC.Type = olCC
        oMail.SentOnBehalfOfName = "email@email.com.au"
        oMail.Recipients.ResolveAll

        'Attachments + message
        oMail.Attachments.Add Range("E9").Offset(i - 1, 0) & "\" & Range("F9").Offset(i - 1, 0)
        oMail.HTMLBody = "<html><p><font face=""Calibri""><font size=3>Dear Sir/ Madam,</p>" & _
                   "<html><p><font face=""Calibri"">Kind regards,</p>"

        'Displays email pre-send
        oMail.Display
        Sheets("Control").Activate

        Set oMail = Nothing
    Next i
End Sub

Answer 1

这是您要尝试的吗？ （ 未经测试 ）

Sub create_email()
    Dim OutApp As Object, oMail As Object
    Dim wb As Workbook, ws As Worksheet
    Dim i As Long, start_Rows As Long, Last_Row As Long

    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Control")

    With ws
        start_Row = .Range("start_row").Row '<~~ Start Row
        Last_Row = .Range("B" & .Rows.Count).End(xlUp).Row '<~~ End Row

        Set OutApp = CreateObject("Outlook.Application")

        For i = start_Row To Last_Row '<~~ Loop from start row to end row
            Set oMail = OutApp.CreateItem(0)

            With oMail
                .Subject = ws.Range("I" & i).Value
                .To = ws.Range("J" & i).Value
                .Cc = ws.Range("K" & i).Value
                .SentOnBehalfOfName = "email@email.com.au"
                .Attachments.Add ws.Range("D" & i).Value & "\" & ws.Range("E" & i).Value
                .HTMLBody = "<html><p><font face=""Calibri""><font size=3>Dear Sir/ Madam,</p>" & _
                            "<html><p><font face=""Calibri"">Kind regards,</p>"

                .Display
            End With
        Next i
    End With
End Sub

在Outlook中使用VBA在Outlook中生成电子邮件

问题描述

1 个解决方案

解决方案1
0 2017-06-02 13:04:11

在Outlook中使用VBA在Outlook中生成电子邮件

问题描述

1 个解决方案

解决方案1 0 2017-06-02 13:04:11

解决方案1
0 2017-06-02 13:04:11