Question

此代码的目的是向提交重分类的用户发送电子邮件草稿。 MailTo和Subject是从excel数据表中提取的：ecEmailAdresses = 17和ecSubject = 43。我需要帮助的行是** If语句**。我希望宏仅在该人提交了重新分类时才起草电子邮件（这也是excel表上的一部分：标有“重新分类”，每个单元格的Y表示是，N表示否）。我将如何处理？谢谢。

此外，下面的代码不断重复自身，使草稿超出我的需要。

 Option Explicit
    'Enumeration is by definition the action of establishing the number of something
    'I Enumerated my Worksheet Columns to give them a meaningful name that is easy to recognize so if the amount is ever moved

    Public Enum EmailColumn
        ecEmailAdresses = 17
        ecSubject = 43
    End Enum
    Public Sub SaveEmails()

    Dim r As Long
    Dim ReCol As Range

    For Each ReCol In Worksheets("Report").Range("AP1:AP1047900").Cells
    If ReCol = "Y" Then

        'The With Statement allows the user to "Perform a series of statements on a specified object without specifying the name of the object multiple times"
        '.Cells(.Row.Count, ecEmailAdresses).End(xlUp).Row actually refers to ThisWorkbook.Worksheets("Data insert").Cells(.Rows.Count, ecEmailAdresses).End(xlUp).Row
        With ThisWorkbook.Worksheets("Report")
            '.Cells(): references a cell or range of cells on Worksheets("Data insert")
            '.Cells(.Rows.Count, ecEmailAdresses): References the last cell in column 43 of the worsheet
            '.End(xlUp): Changes the reference from the last cell to the first used cell above the last cell in column 17
            '.Cells(.Rows.Count, ecEmailAdressess).End(xlUp).Row: returns the Row number of the last cell column 17
            For r = 2 To .Cells(.Rows.Count, ecEmailAdresses).End(xlUp).Row
                getTemplate(MailTo:=.Cells(r, ecEmailAdresses), Subject:=.Cells(r, ecSubject)).Save
            Next
        End With
     End If
     Next ReCol

    End Sub
    Public Function getPOAccrualTemplate(MailTo As String, Optional CC As String, Optional BC As String, Optional Subject As String) As Object
        Const TEMPLATE_PATH As String = "C:\Users\JohnDoe\Documents\Project\ Email Template.oft"

        Dim OutApp As Object
        Dim OutMail As Object
        'CreateObject("Outlook.Application"): Creates an instance of an Outlook Application.
        'Outlook.Application.CreatItemFromTemplate 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 = BC
            .Subject = Subject
        End With

        'Returns the new MailItem to the caller of the function
        Set getTemplate = OutMail

    End Function

Answer 1

一些问题。

Public Function getPOAccrualTemplate(MailTo As String, Optional CC As String, Optional BC As String, Optional Subject As String) As Object 其中包括Set getTemplate = OutMail。应该是（尽管其他效率低下的编码做法）：

Public Function getPOAccrualTemplate(MailTo As String, Optional CC As String, Optional BC As String, Optional Subject As String) As Object
    Const TEMPLATE_PATH As String = "C:\Users\JohnDoe\Documents\Project\PO Accrual Push Back Email Template.oft"
    Dim OutApp As Object
    Dim OutMail As Object
    Set OutMail = CreateObject("Outlook.Application").CreateItemFromTemplate(TEMPLATE_PATH)
    With OutMail
        .To = MailTo
        .CC = CC
        .BCC = BC
        .Subject = Subject
    End With
    Set getPOAccrualTemplate= OutMail
End Function

您在SaveEmails中的循环正在完全按照您的要求进行操作，创建了多个模板。每次您输入“ Y”时，您都将遍历所有行并创建一封电子邮件，从而有效地减少所需电子邮件的数量。如果我正确理解了您的逻辑和数据表，那么删除循环应该可以解决重复问题（尽管存在其他效率低下的编码）。

   If ReCol = "Y" Then
        With ThisWorkbook.Worksheets("Report")
                getTemplate(MailTo:=.Cells(Recol.Row, ecEmailAdresses), Subject:=.Cells(Recol.Row, ecSubject)).Save
        End With
     End If

If声明/ Outlook / VBA：起草电子邮件

1 个答案: