根据单元格值select不同的电子邮件正文

根据D栏中的值，有3个正文内容可供选取。

1）如果“D”列的值是“高”，那么应该selectbodycontent1

2）如果“D”列值是“中”，那么应该selectbodycontent2

3）如果“D”列值是“低”，那么应该selectbodycontent3

下面的代码只是为任何条件selectbodycontent1。

码：

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("[e-mail]") Set RecipBCC = MsgFwd.Recipients.Add(Email) MsgFwd.SentOnBehalfOfName = "[e-mail]" 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的部分比Loop + 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 & " ; [e-mail]" .BCC = Email .SentOnBehalfOfName = "[e-mail]" 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