根據單元格值選擇不同的郵件正文

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("secnww@hp.com") 
Set RecipBCC = MsgFwd.Recipients.Add(Email) 
MsgFwd.SentOnBehalfOfName = "doc@hp.com" 
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 & " ; secnww@hp.com" 
        .BCC = Email 
        .SentOnBehalfOfName = "doc@hp.com" 

        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