Как скопировать адрес электронной почты из тела письма Outlook и вставить его в поле получателя нового сообщения? - PullRequest
0 голосов
/ 13 октября 2018

Каждый день я получаю несколько автоматических электронных писем, которые содержат некоторую информацию, которую необходимо переслать на другой адрес (а) электронной почты.

Этот адрес электронной почты находится в автоматизированной электронной почте,и не всегда будет одинаковым.Этот адрес электронной почты находится в таблице под строкой с пометкой «Замечания».Я вставил картинку, чтобы проиллюстрировать это.

An example

Я хотел бы автоматизировать этот процесс с помощью макросов Outlook VBA.Некоторая дополнительная информация: 1) Я не могу использовать функцию «запустить скрипт» в Правилах.2) Входящие электронные письма автоматизированы и всегда будут иметь одинаковый формат.

Мне нужна помощь по следующим вопросам: 1) Копирование адреса электронной почты в следующем столбце строки «Примечания».

Мне уже удалось автоматизировать процесс распознавания входящей электронной почты (по заголовку темы) и автоматической переадресации на предварительно заданный адрес электронной почты и изменения заголовка переадресованной темы электронной почты.

Private WithEvents Items as Outlook.Items
Private Sub application_startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNameSpace("MAPI")

'Setting target folder as inbox
Set Items = objectNS.GetDefaultFolder(olFolderInbox).Items

End Sub


Private Sub Items_ItemAdd(ByVal Item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.Mailitem

'act only if it is a mail item
If TypeName(Item) = "MailItem" Then
Set Msg = Item

'Detect emails with specified subject title
If Msg.Subject = "Test" Then
Set myForward = Item.Forward
myForward.Recipients.Add("test@gmail.com")
myForward.Subject = "FW: Success"
myForward.Save
myForward.Send
EndIf

EndIf

ProgramExit: Exit Sub

ErrorHandler:
MsgBox Err.Number & "-" & Err.Description
Resume ProgramExit

End Sub

1 Ответ

0 голосов
/ 15 октября 2018

Насколько я понимаю, Вы хотите получить адрес в теле письма.

Вы можете использовать следующий код:

Option Explicit
Sub Example()
    Dim Item As MailItem
    Dim RegExp As Object
    Dim Search_Email As String
    Dim Pattern As String
    Dim Matches As Variant
    Dim len1 As String
    Dim result As String
    Set RegExp = CreateObject("VbScript.RegExp")
    Pattern = "remarks\s+(\b[A-Z0-9._%+-]+\b)"

    For Each Item In ActiveExplorer.Selection

        Search_Email = Item.Body
        With RegExp
            .Global = False
            .Pattern = Pattern
            .IgnoreCase = True
            Set Matches = .Execute(Search_Email)
        End With
        If Matches.Count > 0 Then
             len1 = Matches(0).Length() - 8
             result = Mid(Matches(0), 12, len1)
             result = result + "@gmail.com"
             MsgBox result
             Debug.Print Matches(0)
        Else
             Debug.Print "Not Found "
        End If

    Next

    Set RegExp = Nothing

End Sub

Для получения дополнительной информации, вы можете обратиться по этой ссылке:

Извлечение адреса электронной почты из таблицы в .HTMLbody

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...