VBA для пересылки электронных писем в Outlook

На чтение 4 мин Опубликовано 09.01.2025

Содержание

Вопрос или проблема
Ответ или решение
Изучение VBA для автоматизации пересылки писем в Outlook
Шаг 1: Настройка объекта и событий
Шаг 2: Обработка новых писем через событие ItemAdd
Резюме

Вопрос или проблема

Я пытаюсь создать VBA, который может пересылать полученные мною электронные письма. Единственная проблема заключается в том, что письма, которые я хотел бы переслать, имеют разные темы. Только начало одинаковое. Вот докуда я дошел (это следует вставить в ThisOutlookSession). Кто-нибудь может мне помочь, пожалуйста?

Public WithEvents objInbox As Outlook.Folder
Public WithEvents objInboxItems As Outlook.Items
Private Sub Application_Startup()
    Set objInbox = Outlook.Application.Session.GetDefaultFolder(olFolderInbox)
    Set objInboxItems = objInbox.Items
End Sub

Private Sub objInboxItems_ItemAdd(ByVal item As Object)
    Dim objMail As Outlook.MailItem
    Dim objForward As Outlook.MailItem

    If TypeOf item Is MailItem Then
       Set objMail = item

       'Если это конкретное новое письмо'
       If (objMail.Subject = "Offer Response Received") Then



           Set objForward = objMail.Forward
           'Настроить тему, тело и получателей пересылки'
           With objForward
                .Subject = "Offer accepted"
                .HTMLBody = "<HTML><BODY>Please proceed. </BODY></HTML>" & objForward.HTMLBody
                .Recipients.Add ("")
                .Recipients.Add ("")
                .Recipients.ResolveAll
                .Importance = olImportanceHigh
                .Send
           End With
       End If
    End If
End Sub

Вы можете проверить тему на наличие общего текста в соответствующем письме.

Private Sub objInboxItems_ItemAdd(ByVal item As Object)

    Dim objMail As MailItem
    Dim objForward As MailItem

    Dim beginStr As String
    Dim lenBegin As Long

    beginStr = "общий текст в начале соответствующего письма"
    lenBegin = Len(beginStr)

    If TypeOf item Is MailItem Then

        Set objMail = item

        'Новое письмо, где "начало одинаковое"
        If Left(objMail.Subject, lenBegin) = beginStr Then

            Set objForward = objMail.Forward

            'Настроить тему, тело и получателей пересылки'
            With objForward
                .Subject = "Offer accepted"
                .HTMLBody = "<HTML><BODY>Please proceed. </BODY></HTML>" & objForward.HTMLBody
                '.recipients.Add ("")
                '.recipients.Add ("")
                .recipients.ResolveAll
                .Importance = olImportanceHigh
                .Display    '.Send
            End With

        End If
    End If

End Sub

Ответ или решение

Конечно, давайте рассмотрим, как можно автоматизировать пересылку писем в Outlook, используя VBA. Ваша задача заключается в пересылке электронных писем с похожими, но не идентичными темами. Важным моментом, который вы уже отметили, является то, что начало темы у всех писем одинаково.

Изучение VBA для автоматизации пересылки писем в Outlook

Чтобы создать VBA-скрипт, автоматически пересылающий электронные письма на основе конкретной части темы письма, следуйте нижеприведенным шагам.

Шаг 1: Настройка объекта и событий

Прежде всего, вам нужно определить папку Inbox и её элементы в Outlook, чтобы отслеживать поступающие письма:

Public WithEvents objInbox As Outlook.Folder
Public WithEvents objInboxItems As Outlook.Items

Private Sub Application_Startup()
    Set objInbox = Outlook.Application.Session.GetDefaultFolder(olFolderInbox)
    Set objInboxItems = objInbox.Items
End Sub

Шаг 2: Обработка новых писем через событие `ItemAdd`

Следующий шаг — это создание процедуры для обработки каждого нового поступающего письма и определения, следует ли его переслать:

Private Sub objInboxItems_ItemAdd(ByVal item As Object)

    Dim objMail As MailItem
    Dim objForward As MailItem

    Dim beginStr As String
    Dim lenBegin As Long

    ' Определяем текст, повторяющийся в начале темы письма
    beginStr = "начало темы для пересылки"
    lenBegin = Len(beginStr)

    If TypeOf item Is MailItem Then
        Set objMail = item

        ' Проверка тематического текста письма
        If Left(objMail.Subject, lenBegin) = beginStr Then
            Set objForward = objMail.Forward

            ' Настройка деталей пересылаемого письма
            With objForward
                .Subject = "Обратите внимание: Сделка принята"
                .HTMLBody = "<HTML><BODY>Пожалуйста, продолжайте процесс. </BODY></HTML>" & objForward.HTMLBody
                .Recipients.Add("<введите_имя_получателя@домен.com>")
                .Recipients.ResolveAll
                .Importance = olImportanceHigh
                .Send
            End With
        End If
    End If

End Sub

Резюме

Данный скрипт автоматически пересылает письма, у которых тема начинается с определенного текста, на указанный адрес. Важно убедиться, что название папки и строка начала темы точно совпадают с вашими требованиями для правильного выполнения задачи. Также замените "<введите_имя_получателя@домен.com>" на фактический адрес электронной почты получателя.

Эти пошаговые инструкции и код помогут вам максимально автоматизировать рабочий процесс в Outlook с использованием VBA. Убедитесь, что после внесения изменений вы сохраняете скрипт и перезагружаете Outlook, чтобы он начал работать.