根据单元格值选择不同的电子邮件正文 [英] Choose different email body based on cell value

查看：156
本文介绍了根据单元格值选择不同的电子邮件正文的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！

问题描述



1）如果D列值为高，则bodycontent1应为选择



2）如果D列值为中，则应选择bodycontent2



3）如果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 
 
 
设置olApp = CreateObject （Outlook.Application）
设置olNs = olApp.GetNamespace（MAPI）
设置Inbox = olNs.GetDefaultFolder（olFolderInbox）
设置Items = Inbox.Items 
 
i = 2'i =行2 
 
工作表（Sheet1）'工作表名称
直到IsEmpty（.Cells（i，1））
 
 ItemSubject = .Cells（i，1）.Value'（i，1）=（行2，列1）
 Email = .Cells（i，16）.Value'（i，2）=第2列，第2列）
 Email1 = .Cells（i，2）.Value 
 Criteria1 = .Cells（i，4）.Value 
 
 Bodycontent1 =你好这是用于测试目的1& < BR> 中&安培; _ 
问候& < BR> 中&安培; _ 
开尔文
 
 Bodycontent2 =你好这是为了测试目的2& < BR> 中&安培; _ 
问候& < BR> 中&安培; _ 
开尔文
 
 Bodycontent3 =你好这是为了测试目的3& < BR> 中&安培; _ 
问候& < BR> 中&安培; _ 
开尔文
 
 
'//循环通过收件箱项目向后
对于lngCount = Items.Count到1步-1 
设置项目= Items.Item（lngCount）
 
如果Item.Subject = ItemSubject然后'如果Subject找到
设置MsgFwd = Item.Forward 
 
 
 
 
设置RecipTo = MsgFwd.Recipients.Add（Email1）
设置RecipTo = MsgFwd.Recipients.Add（secnww@hp.com）
设置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 
 
如果Criteria1 =high然后
 
 MsgFwd.HTMLBody = Bodycontent1& Item.HTMLBody 
 
 ElseIf Criteria1 =medium然后
 
 MsgFwd.HTMLBody = Bodycontent2& Item.HTMLBody 
 
否则如果Criteria1 =低则
 
 MsgFwd.HTMLBody = Bodycontent3& Item.HTMLBody 
 
 MsgFwd.Display 
 
如果
结束If 
 
 
 
下一个退出循环
 
i = i + 1'=行2 + 1 =行3 
循环
结束
 
设置olApp = Nothing 
设置olNs =没有
设置收件箱=没有
设置项目=没有
设置MsgFwd =没有
设置项目=没有
 
 MsgBox发送邮件
 
 End Sub


解决方案


  1. 您应该使用选择案例而不是如果/ ElseIf

  2. 看到关于LastRow的部分，它比Loop + i = i + 1 （更多信息here ）

  3. 我已经添加了一个 Exit For （已注释），以防您想要获得时间，只能转发第一条信息与您正在查看的主题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 
 
 
设置olApp = CreateObject（Outlook.Application）
设置olNs = olApp.GetNamespace（MAPI）
设置Inbox = olNs.GetDefaultFolder （olFolderInbox）
设置Items = Inbox.Items 
 
 
 Bodycontent1 =Hello this is for purpose purpose1& < BR> 中&安培; _ 
问候& < BR> 中&安培; _ 
开尔文
 
 Bodycontent2 =你好这是为了测试目的2& < BR> 中&安培; _ 
问候& < BR> 中&安培; _ 
开尔文
 
 Bodycontent3 =你好这是为了测试目的3& < BR> 中&安培; _ 
问候& < BR> 中&安培; _ 
开尔文
 
 
 
设置wS = thisworkbook.Worksheets（Sheet1）'工作表名称
带有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 ，3）.value 
 
'//向后循环收件箱项
对于lngCount = Items.Count到1步-1 
设置Item = Items.Item（lngCount）
 
如果Item.Subject<>然后
 Else 
'如果发现主题然后
设置MsgFwd = Item.Forward 
与MsgFwd 
 .To = Email1& ; secnww@hp.com
 .BCC =电子邮件
 .SentOnBehalfOfName =doc@hp.com
 
选择案例LCase（Criteria1）
案例是=high
 .HTMLBody = Bodycontent1& Item.HTMLBody 
 Case Is =medium
 .HTMLBody = Bodycontent2& Item.HTMLBody 
 Case Is =low
 .HTMLBody = Bodycontent3& Item.HTMLBody 
 Case Else 
 MsgBoxCriteria：&标准1& 不认可！，_ 
 vbCritical + vbOKOnly，案例未处理
结束选择
 
 .Display 
'退出
结束与' MsgFwd 
 End If 
 Next lngCount 
 Next i 
 End with'wS 
 
 Set olApp = Nothing 
 Set olNs = Nothing 
设置收件箱=没有
设置项目=没有
设置MsgFwd =没有
设置项目=没有
 
 MsgBox发送邮件
 
 End Sub


There are 3 body contents to be picked based on the value in D column.

1) if "D" column value is "High" then bodycontent1 should be selected

2) if "D" column value is "Medium" then bodycontent2 should be selected

3) if "D" column value is "Low" then bodycontent3 should be selected

The below code just picks the bodycontent1 for any criteria.

Code: 

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

解决方案

  1. You should use Select Case rather than If/ElseIf
  2. See the part about LastRow which is clear than Loop+i=i+1 (more info here)
  3. I've added an Exit For (commented), in case you want to gain time, and only forward the 1st message with the subject you're looking for!

Final code :

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

这篇关于根据单元格值选择不同的电子邮件正文的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！

查看全文
相关文章
Office最新文章
热门教程
热门工具
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆