セルの値に基づいて別のメール本文を選択してください

Question

D列の値に基づいて選択される3つの本文内容があります。次いで、 "D" 列の値が "高" である場合

1）

2を選択すべきであるbodycontent1） "D" 列の値が "中" である場合

3を選択しなければならないbodycontent2）「IF D "列の値が" Low "の場合、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. 私は、Exit For（コメント）を追加したループ+ i=i+1
3. よりも明らかであるLASTROWに関する部分を参照してくださいを使用する必要がありますあなたは時間を得たいと思って、あなたが探している主題との最初のメッセージだけを転送してください！

決勝コード：

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