Excel VBA, чтобы включить тело в перенаправленном Outlook Email


4

Я пытаюсь перенаправить письма на основе темы, предоставленной в столбце A, путем циклирования. Он работает отлично, но я также хотел бы включить содержимое в столбец C в каждую соответствующую почту.

Также удалите и отправьте информацию с начальной почтой.

enter image description here

шаблона запроса:

Содержание орган должен также использовать значение столбца, как указано ниже.

enter image description here

Может кто-нибудь помочь мне удалить и включить эти детали в ниже ..

Option Explicit 
Public Sub Example() 
Dim olApp As Outlook.Application 
Dim olNs As Outlook.Namespace 
Dim Inbox As Outlook.MAPIFolder 
Dim Item As Variant 
Dim MsgFwd As MailItem 
Dim Items As Outlook.Items 
Dim Email As String 
Dim Email1 As String 
Dim ItemSubject As String 
Dim lngCount As Long 
Dim i As Long 
Dim RecipTo As Recipient 
Dim RecipCC As Recipient 
Dim RecipBCC As Recipient 
Dim onbehalf As Variant 



Set olApp = CreateObject("Outlook.Application") 
Set olNs = olApp.GetNamespace("MAPI") 
Set Inbox = olNs.GetDefaultFolder(olFolderInbox) 
Set Items = Inbox.Items 

i = 2 ' i = Row 2 

With Worksheets("Sheet1") ' Sheet Name 
    Do Until IsEmpty(.Cells(i, 1)) 

    ItemSubject = .Cells(i, 1).Value '(i, 1) = (Row 2,Column 1) 
    Email = .Cells(i, 16).Value '(i, 2) = (Row 2,Column 2) 
    Email1 = .Cells(i, 2).Value 

     '// Loop through Inbox Items backwards 
     For lngCount = Items.Count To 1 Step -1 
      Set Item = Items.Item(lngCount) 

      If Item.Subject = ItemSubject Then ' if Subject found then 
       Set MsgFwd = Item.Forward 
       Set RecipTo = MsgFwd.Recipients.Add(Email1) ' add To Recipient 
       Set RecipTo = MsgFwd.Recipients.Add("[email protected]") 
       Set RecipBCC = MsgFwd.Recipients.Add(Email) ' add BCC Recipient 
       MsgFwd.SentOnBehalfOfName = "[email protected]" 


        RecipTo.Type = olTo 
        RecipBCC.Type = olBCC 
        MsgFwd.Display 

      End If 
     Next ' exit loop 

     i = i + 1 ' = Row 2 + 1 = Row 3 
    Loop 
End With 

Set olApp = Nothing 
Set olNs = Nothing 
Set Inbox = Nothing 
Set Item = Nothing 
Set MsgFwd = Nothing 
Set Items = Nothing 

MsgBox "Mail sent" 
End Sub 
2

Добавить новую переменную в строку Dim EmailBody As String затем присвоить колонке C EmailBody = .Cells(i, 3).Value с в вашем Do Loop

Для того, чтобы удалить следующие из Item.Forward тела, просто добавьте ваш Item.Body к вашему MsgFwd.Body - он должен заменить все вперед тело электронной почты с Item.Body только


enter image description here

MsgFwd.HTMLBody = EmailBody & "<BR>" & "<BR>" & Item.HTMLBody


Пример

Dim EmailBody As String 
With Worksheets("Sheet1") ' Sheet Name 
    Do Until IsEmpty(.Cells(i, 1)) 

    ItemSubject = .Cells(i, 1).Value '(i, 1) = (Row 2,Column 1) 
    Email = .Cells(i, 16).Value '(i, 2) = (Row 2,Column 2) 
    Email1 = .Cells(i, 2).Value 
    EmailBody = .Cells(i, 3).Value 

     '// Loop through Inbox Items backwards 
     For lngCount = Items.Count To 1 Step -1 
      Set Item = Items.Item(lngCount) 

      If Item.Subject = ItemSubject Then ' if Subject found then 
       Set MsgFwd = Item.Forward 
       Set RecipTo = MsgFwd.Recipients.Add(Email1) ' add To Recipient 
       Set RecipTo = MsgFwd.Recipients.Add("[email protected]") 
       Set RecipBCC = MsgFwd.Recipients.Add(Email) ' add BCC Recipient 
       MsgFwd.SentOnBehalfOfName = "[email protected]" 

       RecipTo.Type = olTo 
       RecipBCC.Type = olBCC 

       Debug.Print Item.Body ' Immediate Window 

       MsgFwd.HTMLBody = EmailBody & "<BR>" & "<BR>" & Item.HTMLBody 
       MsgFwd.Display 

      End If 
     Next ' exit loop 
  0

Спасибо @ 0m3r, что прекрасно работает .. Только одна вещь отсутствует. В содержимом тела Hello «D» относится к столбцу D.value. Поэтому мне нужно обновить имя автоматически на основе значения. Было бы возможно? 15 мар. 172017-03-15 09:49:52

+1

@ Kelvin просто добавьте еще одну переменную в ваш 'do loop' Пример' BodyName = .Cells (i, 4) .Value' затем в 'MsgFwd.HTMLBody = EmailBody &" "& BodyName &" <BR> "&" <BR> "& Item.HTMLBody' 15 мар. 172017-03-15 09:57:58

+1

Превосходно, спасибо. Я действительно должен вам :) 15 мар. 172017-03-15 10:05:44