Question

此代码从我制作的模板中生成电子邮件，并从excel表中获取信息（MailtTo和电子邮件的主题行）。现在，它将保存到Outlook中的草稿文件夹中，以便以后发送。我试图弄清楚如何编写一个宏，该宏将在Outlook中创建一个名为“ Reclass”的新文件夹，该文件夹仍处于这些电子邮件将进入的草稿类别中。我该怎么办？

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 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 = "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(.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
                getTemplate(MailTo:=.Cells(ReCol.Row, ecEmailAdresses), Subject:=.Cells(ReCol.Row, ecSubject)).Save

            End With

        End If

    Next

End Sub

Public Function getTemplate(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

首先，您需要检查目标文件夹是否存在。 GetDefaultFolder方法返回一个Folder对象，该对象表示当前配置文件所请求类型的默认文件夹；默认情况下，该文件夹为所请求类型的默认文件夹。例如，为当前登录的用户获取默认的Calendar文件夹。

Sub ChangeCurrentFolder() 
  Dim myNamespace As Outlook.NameSpace 
  Set myNamespace = Application.GetNamespace("MAPI") 
  Set Application.ActiveExplorer.CurrentFolder = _ myNamespace.GetDefaultFolder(olFolderDrafts) 
End Sub

使用Folders属性获取子文件夹的集合。 Folders.Add方法在“文件夹”集合中创建一个新文件夹。

Sub AddContactsFolder() 
  Dim myNameSpace As Outlook.NameSpace 
  Dim myFolder As Outlook.Folder 
  Dim myNewFolder As Outlook.Folder 

  Set myNameSpace = Application.GetNamespace("MAPI") 
  Set myFolder = myNameSpace.GetDefaultFolder(olFolderDrafts) 
  Set myNewFolder = myFolder.Folders.Add("My subfolder") 
End Sub

要将新邮件项保存到特定文件夹，您需要使用Move方法，如以下示例代码所示：

Imports System.Runtime.InteropServices
' ...
Private Sub CreateItemBasedOnTemplate(Application As Outlook.Application)
  Dim ns As Outlook.NameSpace = Nothing
  Dim containerFolder As Outlook.MAPIFolder = Nothing
  Dim item As Outlook.MailItem = Nothing
  Dim movedItem As Outlook.MailItem = Nothing
  Try
    ns = Application.GetNamespace("MAPI")
    containerFolder = ns.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)
    item = Application.CreateItemFromTemplate("D:\MyTemplate.oft", containerFolder)
    ' the item was created in the Drafts folder regardless
    ' that is why we move it to the Inbox folder
    movedItem = item.Move(containerFolder)
    movedItem.Save()
    movedItem.Display()
  Catch ex As COMException
    If (ex.ErrorCode = -2147287038) Then
       System.Windows.Forms.MessageBox.Show(ex.Message,
           "Can't find the template...")
    Else
       System.Windows.Forms.MessageBox.Show(ex.Message,
           "An error was occurred when creating a new item from template...")
    End If
  Finally
    If Not IsNothing(movedItem) Then Marshal.ReleaseComObject(movedItem)
    If Not IsNothing(item) Then Marshal.ReleaseComObject(item)
    If Not IsNothing(containerFolder) Then Marshal.ReleaseComObject(containerFolder)
    If Not IsNothing(ns) Then Marshal.ReleaseComObject(ns)
  End Try
End Sub

您可能会发现How To: Create a new Outlook message based on a template文章很有帮助。

使用VBA在Outlook上创建新的草稿文件夹

1 个答案: