Question

根据D栏中的值，有3个身体内容被选中。

1）如果＆＃34; D＆＃34;列值为＆＃34;高＆＃34;然后应选择bodycontent1

2）如果＆＃34; D＆＃34;列值为＆＃34;中等＆＃34;然后应选择bodycontent2

3）如果＆＃34; D＆＃34;列值为＆＃34;低＆＃34;然后应选择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

您应该使用Select Case而不是If/ElseIf
请参阅有关LastRow的部分，该部分比Loop + i=i+1
我添加了一个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

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

1 个答案: