Изменить автоматически отправленное письмо, чтобы удалить строки в начале - PullRequest
Новая
       8

Изменить автоматически отправленное письмо, чтобы удалить строки в начале

0 голосов
/ 06 февраля 2020

Правило добавляет две строки в начало электронного письма для конкретного проекта и пересылает его мне.

Мне нужно удалить эти две строки.

Мой подход -

У меня есть письма в указанной папке c (скажем, папка "Пробная версия").
С помощью следующего кода я открываю письма в указанной папке c и получаю их в режиме редактирования. .

Дальнейшие шаги в моем алгоритме -

  1. Чтобы удалить первые две строки в теле (независимо от содержимого).
  2. Чтобы сохранить почту в другой папке. 
Sub Change_Body_and_Save()

Dim olApp As Outlook.Application
Dim olNs As NameSpace
Dim Fldr As MAPIFolder
Dim subfldr As MAPIFolder
Dim olkInsp As Outlook.Inspector
Dim olMail As Variant
Dim i As Integer

Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
Set subfldr = Fldr.Folders("Trial")
MsgBox (subfldr)
i = 1

For Each olMail In subfldr.Items
    olMail.Display
    ActiveInspector.CommandBars.ExecuteMso "EditMessage"
    *code to be added here*
Next olMail

End Sub

1 Ответ

0 голосов
/ 10 февраля 2020 
Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration

Sub Change_Body_and_Save()

'Dim olApp As Outlook.Application

Dim olNs As NameSpace

'Dim Fldr As MAPIFolder
Dim Fldr As folder

'Dim subfldr As MAPIFolder
Dim subfldr As folder

Dim targetFldr As folder

'Dim olkInsp As Outlook.Inspector

Dim olObj As Object
'Dim olMail As Variant
Dim olMitm As MailItem  ' new name, olMail means something in Outlook

'Dim i As Integer

'Set olApp = New Outlook.Application

'Set olNs = olApp.GetNamespace("MAPI")
Set olNs = GetNamespace("MAPI")

Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
Set subfldr = Fldr.folders("Trial")

'MsgBox (subfldr)
Debug.Print subfldr

Set targetFldr = Fldr.folders("TrialEditedMail")
Debug.Print targetFldr

Dim msgPrefix As String
Dim msgPrefixLen As Long

'i = 1

msgPrefix = "text to be replaced"
msgPrefixLen = Len(msgPrefix)

'For Each olMail In subfldr.Items
    'olMail.Display
    'ActiveInspector.CommandBars.ExecuteMso "EditMessage"
    '*code to be added here*
'Next olMail

For Each olObj In subfldr.Items

    If olObj.Class = olMail Then

        Set olMitm = olObj

        If Left(olMitm.Body, msgPrefixLen) = msgPrefix Then

            With olMitm

                If InStr(.Body, msgPrefix) Then

                    If .BodyFormat = olFormatHTML Then
                        .HTMLBody = Replace(.HTMLBody, msgPrefix, "")
                    Else
                        .Body = Replace(.Body, msgPrefix, "")
                    End If

                    .Move targetFldr

                End If

            End With

        End If

    End If

Next

End Sub
...