根据单元格值选择不同的邮件正文

Question

根据D列中的值选择3个正文内容。

1）如果bodycontent1应选择

2）如果 “d” 栏中的值是 “中等”，那么bodycontent2应选择

3）如果“ ”d“ 栏中的值是 ”高“，那么D“列值为”低“，那么应选择bodycontent3

下面的代码只是为任何条件选取bodycontent1。

代码：

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 
Dim EmailBody As String 
Dim BodyName As String 
Dim Bodycontent1 As String 
Dim Bodycontent2 As String 
Dim Bodycontent3 As String 
Dim Criteria1 As String 


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 
Criteria1 = .Cells(i, 4).Value 

Bodycontent1 = "Hello this is for testing purpose1" & "<BR>" & _ 
"Regards," & "<BR>" & _ 
"Kelvin" 

Bodycontent2 = "Hello this is for testing purpose2" & "<BR>" & _ 
"Regards," & "<BR>" & _ 
"Kelvin" 

Bodycontent3 = "Hello this is for testing purpose3" & "<BR>" & _ 
"Regards," & "<BR>" & _ 
"Kelvin" 


'// 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) 
Set RecipTo = MsgFwd.Recipients.Add("[email protected]") 
Set RecipBCC = MsgFwd.Recipients.Add(Email) 
MsgFwd.SentOnBehalfOfName = "[email protected]" 
BodyName = .Cells(i, 3).Value 

RecipTo.Type = olTo 
RecipBCC.Type = olBCC 

Debug.Print Item.Body 

If Criteria1 = "high" Then 

MsgFwd.HTMLBody = Bodycontent1 & Item.HTMLBody 

ElseIf Criteria1 = "medium" Then 

MsgFwd.HTMLBody = Bodycontent2 & Item.HTMLBody 

Else 'If Criteria1 = "Low" Then 

MsgFwd.HTMLBody = Bodycontent3 & Item.HTMLBody 

MsgFwd.Display 

End If 
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 

Answer 1

1. 你应该使用Select Case而不是If/ElseIf
2. 查看关于LASTROW部分比环清晰+ i=i+1
3. 我添加了一个Exit For（评论），在你想获得时间的情况下，只有第一条消息与你正在寻找的主题！

最终代码：

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 wS As Worksheet 
Dim Items As Outlook.Items 
Dim Email As String 
Dim Email1 As String 
Dim ItemSubject As String 
Dim lngCount As Long 
Dim LastRow As Long 
Dim i As Long 
Dim BodyName As String 
Dim Bodycontent1 As String 
Dim Bodycontent2 As String 
Dim Bodycontent3 As String 
Dim Criteria1 As String 


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


Bodycontent1 = "Hello this is for testing purpose1" & "<BR>" & _ 
"Regards," & "<BR>" & _ 
"Kelvin" 

Bodycontent2 = "Hello this is for testing purpose2" & "<BR>" & _ 
"Regards," & "<BR>" & _ 
"Kelvin" 

Bodycontent3 = "Hello this is for testing purpose3" & "<BR>" & _ 
"Regards," & "<BR>" & _ 
"Kelvin" 



Set wS = thisworkbook.Worksheets("Sheet1") ' Sheet Name 
With wS 
    LastRow = .Range("A" & .rows.Count).End(xlup).Row 
    For i = 2 To LastRow 
     ItemSubject = .Cells(i, 1).value 
     Email = .Cells(i, 16).value 
     Email1 = .Cells(i, 2).value 
     Criteria1 = .Cells(i, 4).value 
     BodyName = .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 
      Else 
       'If Subject found then 
       Set MsgFwd = Item.Forward 
       With MsgFwd 
        .To = Email1 & " ; [email protected]" 
        .BCC = Email 
        .SentOnBehalfOfName = "[email protected]" 

        Select Case LCase(Criteria1) 
         Case Is = "high" 
          .HTMLBody = Bodycontent1 & Item.HTMLBody 
         Case Is = "medium" 
          .HTMLBody = Bodycontent2 & Item.HTMLBody 
         Case Is = "low" 
          .HTMLBody = Bodycontent3 & Item.HTMLBody 
         Case Else 
          MsgBox "Criteria : " & Criteria1 & " not recognised!", _ 
            vbCritical + vbOKOnly, "Case not handled" 
        End Select 

        .Display 
        'Exit For 
       End With 'MsgFwd 
      End If 
     Next lngCount 
    Next i 
End With 'wS 

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

MsgBox "Mail sent" 

End Sub