我想在两个符号之间拉文本：
S1 | STAR2449524 | XYZ银行| 1 - 严重|健康服务心跳失败。
我需要提取| XYZ银行|
在符号的2＆＃39dd之间，并将其放在我的模板中，其中变量名称为COMP1 |
Sub Reply_Test()
Dim origEmail As MailItem
Dim replyEmail As MailItem
Dim oRespond As Outlook.MailItem
Dim INC1 As String 'For Incident Number
Dim INo As Integer 'For Incident Number
Dim COMP1 As String 'For Company Name
Dim Com As Integer 'For Company Name
Dim ISSU1 As String ' For Issue
Dim Isu As Integer 'for Issue
Dim varSplit As Variant
'Dim msginfo As msg.Subject (Tried using not worked)
varSplit = Split("New incident |S1 | ICM1449524 | XYZ Bank | P1 - Critical |Health Service Heartbeat Failure.", "|")
'varSplit = Split(msginfo, "|") (Tried using not worked)
strSubject1 = varSplit(0)
strSubject2 = varSplit(1)
strSubject3 = varSplit(2)
strSubject4 = varSplit(3)
strSubject5 = varSplit(4)
Set origEmail = Application.ActiveWindow.Selection.Item(1)
Set replyEmail = Application.CreateItemFromTemplate("H:\Documents\test.oft")
replyEmail.To = origEmail.Reply.To
replyEmail.CC = "abc@xyz.com"
replyEmail.HTMLBody = replyEmail.HTMLBody & origEmail.Reply.HTMLBody
replyEmail.Subject = replyEmail.Subject & origEmail.Reply.Subject
replyEmail.Subject = " <P1> - " & strSubject2 & " " & "For" & " " & strSubject3
replyEmail.Display
End Sub
答案 0 :(得分：0)
在我的评论中建议的替代宏，您可能会发现下面的更方便。添加如下内容：
Debug.Print "=====Text====="
Debug.Print TidyTextForDspl(.Body)
Debug.Print "=====Html====="
Debug.Print TidyTextForDspl(.HTMLBody)
Debug.Print "=====End====="
到您现有的宏。
Public Function TidyTextForDspl(ByVal Text As String) As String
' Tidy Text for dsplay by replacing white space with visible strings:
' Replace spaces by {s} or {n s}
' Replace line feed by {lf} or {n lf}
' Replace carriage return by {cr} or {n cr}
' Replace tab by {tb} or {n tb}
' Replace non-break space by {nbs} or {n nbs}
' Where n is a count if the character repeats
' 15Mar16 Coded
Dim InsStr As String
Dim InxWsChar As Long
Dim NumWsChar As Long
Dim PosWsChar As Long
Dim RetnVal As String
Dim WsCharCrnt As Variant
Dim WsCharValue As Variant
Dim WsCharDspl As Variant
WsCharValue = Array(" ", vbLf, vbCr, vbTab, Chr(160))
WsCharDspl = Array("s", "lf", "cr", "tb", "nbs")
RetnVal = Text
For InxWsChar = LBound(WsCharValue) To UBound(WsCharValue)
Do While True
PosWsChar = InStr(1, RetnVal, WsCharValue(InxWsChar))
If PosWsChar = 0 Then
Exit Do
End If
NumWsChar = 1
Do While Mid(RetnVal, PosWsChar + NumWsChar, 1) = WsCharValue(InxWsChar)
NumWsChar = NumWsChar + 1
Loop
If NumWsChar = 1 Then
InsStr = "{" & WsCharDspl(InxWsChar) & "}"
Else
InsStr = "{" & NumWsChar & WsCharDspl(InxWsChar) & "}"
End If
RetnVal = Mid(RetnVal, 1, PosWsChar - 1) & InsStr & Mid(RetnVal, PosWsChar + NumWsChar)
Loop
Next
TidyTextForDspl = RetnVal
End Function
回复评论中的问题的新栏目
InStr对您的要求不是最有用的功能。我推荐Split
Split在分隔符上拆分一个字符串，并将这些部分作为一个从零开始的一维数组返回。
文档说Split总是返回一个从零开始的数组，我总是发现这是真的。但是，有些函数受Option Base语句的影响，所以我总是使用LBound函数来绝对清楚我正在访问哪个元素。
这个小宏使用Split来分割你的示例字符串。我使用Trim删除任何前导或尾随空格。
Option Explicit
Sub Test()
Dim Inx As Long
Dim Parts() As String
Parts = Split("S1 | ICM21449524 | XYZ Bank | P1 - Critical |Health Service Heartbeat Failure", "|")
For Inx = LBound(Parts) To UBound(Parts)
Debug.Print Inx & " [" & Trim(Parts(Inx)) & "]"
Next
End Sub
第二个新栏目
你没有回答我的问题。也许你不明白它的意义所以我会给出两个最有可能答案的演示代码。
如果您希望宏处理某些电子邮件，可以通过不同的方式指定要处理的电子邮件。
一种方法是用户在启动宏之前选择要处理的所有电子邮件。如果您在电子邮件中单击 LeftMouse ，则会将其选中。如果您在单击向上或向下时按住 Shift ，则可以选择一组连续的电子邮件。如果您在电子邮件中单击 LeftMouse 时按住 Ctrl ，则可以选择不连续的电子邮件。
选择一些电子邮件，然后运行此宏：
Public Sub DemoExplorer()
Dim Exp As Outlook.Explorer
Dim ItemCrnt As MailItem
Dim NumSelected As Long
Set Exp = Outlook.Application.ActiveExplorer
NumSelected = Exp.Selection.Count
If NumSelected = 0 Then
Debug.Print "No emails selected"
Else
For Each ItemCrnt In Exp.Selection
With ItemCrnt
Debug.Print "--------------------------"
Debug.Print "From: " & .SenderName
Debug.Print "Subject: " & .Subject
Debug.Print "Received: " & Format(.ReceivedTime, "dMMMyy h:mm:ss")
End With
Next
End If
End Sub
上面的宏是我的标准演示宏之一。它将每个所选电子邮件的许多属性输出到即时窗口。你只对主题感兴趣，但我决定留下其他人参考。
另一种方法是用户将要处理的电子邮件移动到名称为“ToProcess”的特殊文件夹。宏被编码为查看文件夹“ToProcess”并处理其中的电子邮件。处理完电子邮件后，可以将它们移动到另一个名称为“已处理”的文件夹。这不是我喜欢的方法，因此我没有代码来演示它。相反，我解释了如何修改下一个宏来匹配这种方法。
我最常用的方法是在收件箱中搜索具有特定特征的新电子邮件。宏处理这些电子邮件，然后将它们移动到“已处理”文件夹。这种方法使用户无需费心搜索要处理的电子邮件并将其移动两次。
以下代码需要在默认收件箱中找到“Processed2”文件夹。在默认收件箱中创建文件夹“Processed2”并保持我的代码不变或修改我的代码，以便FolderDest2引用您选择的文件夹。此代码处理主题中带有管道“|”的任何电子邮件。您需要扩展我的代码，以便只处理所需的电子邮件。
Public Sub DemoSearch()
Dim FolderDest2 As MAPIFolder
Dim FolderDest1 As MAPIFolder
Dim FolderSrc1 As MAPIFolder
Dim FolderSrc2 As MAPIFolder
Dim InxItemCrnt As Long
Dim InxPart As Long
Dim NS As Outlook.NameSpace
Dim SubjectPart() As String
Set NS = CreateObject("Outlook.Application").GetNamespace("MAPI")
' This is the easiest way to reference the default Inbox.
' However, you must be careful if, like me, you have multiple email addresses
' each with their own Inbox. The default Inbox may not be where you think it is.
Set FolderSrc1 = NS.GetDefaultFolder(olFolderInbox)
' This references the Inbox in a specific PST or OST file.
' "tonydallimore23@gmail.com" is the user name that Outlook gave the OST file in
' which it stores emails sent to this account when I created the account. The user
' name is the name Output displays to the user. The file name on disk is different.
Set FolderSrc2 = NS.Folders("tonydallimore23@gmail.com").Folders("Inbox")
' I do not know where you want to save processed emails. I have created
' FolderDest1 to show how to access a folder at the same level as Inbox
' but my code uses FolderDest2 which is a sub-folder of Inbox.
' This gets a reference to folder "Processed1" which is at the same level
' as the default Inbox.
' I have started at FolderSrc1 (Inbox) gone up one level to its parent
' (outlook data file) and doen to another child ("Processed1")
Set FolderDest1 = FolderSrc1.Parent.Folders("Processed1")
' This gets a reference to folder "Processed2" which is a sub-folder of
' the default Inbox.
Set FolderDest2 = FolderSrc1.Folders("Processed2")
' This examines the emails in reverse order.
' If I process email number 5 and then move it to another folder,
' the number of all subsequence emails is decreased by 1. If I looked at the
' emails in ascending sequence, email 6 would be ignored because it would have
' been renumbered wehn I looked for it. By looking at the emails in reverse
' sequence, I ensure email 6 has bee processed before the removal of email 5
' changes its number.
' I do not know how you identify the emails you want to process. I process
' any email with a pipe , "|", in the Subject
For InxItemCrnt = FolderSrc1.Items.Count To 1 Step -1
With FolderSrc1.Items.Item(InxItemCrnt)
If .Class = olMail Then
' I am only interested in mail items.
If .Subject <> "" Then
' ONlt attept split if there is a Subject
SubjectPart = Split(.Subject, "|")
If LBound(SubjectPart) <> UBound(SubjectPart) Then
' There is at least one pipe, "|", within the subject
Debug.Print "====="
Debug.Print " Sender " & .SenderEmailAddress
Debug.Print " Received " & Format(.ReceivedTime, "ddmmmyy hh:mm:ss")
Debug.Print " Subject: "
For InxPart = LBound(SubjectPart) To UBound(SubjectPart)
Debug.Print " " & Trim(SubjectPart(InxPart))
Next InxPart
.Move FolderDest2
End If ' LBound(SubjectPart) <> UBound(SubjectPart)
End If ' .Subject <> ""
End If ' .Class = olMail
End With ' FolderSrc1.Items.Item(InxItemCrnt)
Next InxItemCrnt
End Sub
如果您更喜欢我的第二种方法，则需要稍微修改上述代码。必须删除靠近底部的.Move FolderDest2。顶部附近的语句指定源文件夹将需要修改。我建议您保留代码以识别要处理的电子邮件，以防案例意外将不适当的电子邮件移动到源文件夹。
我希望运行这两个宏能够充分解释我的问题的重要性。我想只提供您喜欢的电子邮件选择方法的代码。我现在提供了两种主要方法的代码。选择最符合您要求的宏作为基础。