如果我在outlook中选择4封电子邮件并运行下面的代码，它应该在电子邮件主体上创建4封具有不同名字的新电子邮件。但是代码只在电子邮件1上获取名字，并将其显示到第2到第4个。
的例子:
- Email 1: First Name Person1
- Email 2: First Name Person2
- Email 3: First Name Person3
- Email 4: First Name Person4
生成的邮件结果应该是:
- Email 1: Person1
- Email 2: Person2
- Email 3: Person3
- Email 4: Person4
.
Sub FindName()
Dim olMail As Outlook.MailItem
Dim Selection As Selection
Dim obj As Object
Set olMail = Application.ActiveExplorer().Selection(1)
Set Selection = Application.ActiveExplorer.Selection
For Each obj In Selection
Set objMsg = Application.CreateItem(olMailItem)
Dim rxp4 As New RegExp, m4 As Match, c4 As MatchCollection, FName As String
rxp4.pattern = "First Names*(s*(w.*b))"
rxp4.Global = True
Set c4 = rxp4.Execute(olMail.Body)
For Each m4 In c4
FName = m4.SubMatches(0) + " "
Next
'--------------------------
With objMsg
.To = "test@mail.com"
.Subject = obj.Subject
'.Body = obj.Body
.HTMLBody = _
"<HTML><BODY>" & _
"<div style='font-size:10pt;font-family:Verdana'>" & _
"<table style='font-size:10pt;font-family:Verdana'>" & _
"<tbody>" & _
"<tr class='blue'><td>" + FName & "</td></tr>" & _
"<tbody>" & _
"</table>" & _
"</div>" & _
"</BODY></HTML>"
.Display
End With
'---------------------------
Next
End Sub
部分答案-我不熟悉RegEx，但我想在你的代码的前半部分做一些改变
Sub FindName()
Dim olMail As Outlook.MailItem
Dim Selection As Selection
Dim obj As Object
' Added or moved the following
Dim rxp4 As New RegExp, m4 As Match, c4 As MatchCollection, FName As String
Dim Ptr As Integer
' End of Additions
'Set olMail = Application.ActiveExplorer().Selection(1)
Set Selection = Application.ActiveExplorer.Selection
For Each obj In Selection
' Added the following
Ptr = Ptr + 1
Set olMail = Application.ActiveExplorer().Selection(Ptr)
' End of Aadditions
Set objMsg = Application.CreateItem(olMailItem)
'Dim rxp4 As New RegExp, m4 As Match, c4 As MatchCollection, FName As String
rxp4.Pattern = "First Names*(s*(w.*b))"
rxp4.Global = True