VBA / Outlook составление писем на основе таблицы Excel - PullRequest
Новая
       20

VBA / Outlook составление писем на основе таблицы Excel

0 голосов
/ 04 июля 2018

Ниже приведен код, который я извлекаю из таблицы Excel
в шаблон внешнего вида. Я хотел бы, чтобы этот код делал еще две вещи, но мне трудно его понять.

  1. Вместо сохранения писем в «Черновике» я хотел бы, чтобы код создал новую папку с именем «Переклассификация» и сохранил неотправленные письма.

  2. Использование оператора If (я думаю), который делает так, что только пользователи (это раздел в моей таблице Excel, из которого я извлекаю часть MailTo для моей электронной почты), у которых есть строка Y ( В столбце переклассификации таблицы указывается буква «Y» или «N»), черновик письма составляется для последующей отправки. 

    Public Enum EmailColumns
    ecEmailAdresses = 44
    ecSubject = 43
End Enum
Public Sub SaveEmails()
    Dim r As Long
    '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 44
        '.Cells(.Rows.Count, ecEmailAdressess).End(xlUp).Row: returns the Row number of the last cell column 44
        For r = 2 To .Cells(.Rows.Count, ecEmailAdresses).End(xlUp).Row
            getPOAccrualTemplate(MailTo:=.Cells(r, ecEmailAdresses), Subject:=.Cells(r, ecSubject)).Save
        Next
    End With

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\JoeDoe\Documents\Project\Email Template.oft"
    Dim OutApp As Object, 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

1 Ответ

0 голосов
/ 04 июля 2018

Вместо использования Application.CreateItemFromTemplate используйте MAPIFolder.Items.Add, где MAPIFolder - это папка, полученная из OOM. Предполагая, что эта папка находится на том же уровне, что и папка «Черновики», попробуйте что-то вроде следующего: 

set app = CreateObject("Outlook.Application")
set ns = app.GetNamespace("MAPI")
ns.Logon
set drafts = ns.GetDefaultFolder(olFolderDrafts)
on error resume next 'the line below can raise an exception if the folder is not found
set myFolder = drafts.Parent.Folders("Reclass")
if myFolder Is Nothing Then
  set myFolder = drafts.Parent.Folders.Add("Reclass")
end If
set OutMail = myFolder.Items.Add
...