Question

下面的宏在Outlook上创建一个文件夹，然后根据excel表的信息并根据保存的电子邮件模板创建电子邮件，这些电子邮件模板将在以后发送。我在宏中编写时遇到的两件事是：

（1）将创建的电子邮件保存到创建的文件夹中（当前直接进入“草稿”文件夹）。

（2）每次为该宏剪切重复的电子邮件都会在某人的部分旁边有一个“ 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 EmailColumns
    ecEmailAdress = 44
    ecSubject = 43
End Enum
Sub create_Folder()

Dim objOutlook As Object
Dim objNameSpace As Namespace
Dim objFolder As Outlook.Folder
Dim objMyfolder As Outlook.Folder
Dim i As Long
Dim objNewFolder As Folder

Const Drafts = 1 ' Draft Items folder

Set objOutlook = CreateObject("Outlook.Application")
Set objNameSpace = objOutlook.GetNamespace("MAPI")

Set objFolder = objNameSpace.GetDefaultFolder(olFolderDrafts)
'sets objFolder to the Draft for it's reference

Set objMyfolder = objFolder.Parent
'Set objMyfolder as the Draft's parent folder

For i = 1 To objMyfolder.Folders.Count

    If objMyfolder.Folders.Item(i).Name = "Support Email" Then
        MsgBox "exists"
        Exit Sub
    End If
Next

    Set objNewFolder = objMyfolder.Folders.Add("Support Email")
    MsgBox "Created"

End Sub

Public Sub SaveEmails()


 Dim ReCol As Range 'Relcass Column Range

 'For Eeach: picking up the reclass section on the OP Report as a renage
  For Each ReCol In Worksheets("Report").Range("AP1:AP1047900")

   'If:Running through Reclass column for only Y respones
    If ReCol = "N" 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("Report").Cells(.Rows.Count, ecEmailAdresses).End(xlUp).Row
        With ThisWorkbook.Worksheets("Report")

           '.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 44
           '.Cells(.Rows.Count, ecEmailAdressess).End(xlUp).Row: returns the Row number of the last cell column 44
             getSupportTemplate(MailTo:=.Cells(ReCol.Row, ecEmailAdress), Subject:=.Cells(ReCol.Row, ecSubject)).Save

        End With

    End If

  Next

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 = "\\template\support email.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 =  "Support - " & Subject
             End With

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

End Function

将电子邮件保存到特定的Outlook文件夹并减少重复的电子邮件

0 个答案: