vba 在 Outlook 正文中搜索结构化文本
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/20001670/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Search structured text in Outlook body
提问by user2970215
I need to find a line in a selected mail and copy it.
我需要在选定的邮件中找到一行并复制它。
The line contains
该行包含
Mailbox: ????????????????
邮箱：??????????????????
The number of symbols in that line are different
该行中的符号数量不同
The mail looks somewhat like this
邮件看起来有点像这样
Mailbox Details
==============================================================================
Mailbox: /xxxxxx/xxxxxxxxxx/xxxxxxxxx
Message Name: xxxxxxxxxxxxxxxxxxxxxxxxx
Message Id: xxxxxxxxxxxxxxx
==============================================================================
The copied line should go into the subject of a new mail created by the code.
复制的行应该进入由代码创建的新邮件的主题。
All I am missing is how to copy the line into the subject.
我所缺少的是如何将该行复制到主题中。
Sub SterlingForward()
Set objItem = ForwardB()
Set objItem = ForwardA()
End Sub
Function ForwardA() As Object
Dim oAccount As Outlook.Account
Dim initialSubj, finalSubj As String
Dim oMail As Outlook.MailItem
Set oMail = Application.ActiveExplorer.Selection(1).Reply
oMail.SentOnBehalfOfName = "[email protected]"
oMail.To = "[email protected]"
oMail.Display
Set myitem = Application.ActiveInspector.CurrentItem
initialSubj = myitem.Subject
initialBod = myitem.Body
finalSubj = ??????????????????????
finalBody = "Hello Team," + vbCrLf + "resend was successful" + vbCrLf & CStr(initialBod)
myitem.Subject = finalSubj
myitem.Body = finalBody
End Function
Function ForwardB() As Object
Dim objMail As Outlook.MailItem
Dim initialSubj, initialBod, finalSubj, finalBody As String
Set objItem = GetCurrentItem()
Set objMail = objItem.Forward
objMail.To = "[email protected]"
objMail.Display
Set objItem = Nothing
Set objMail = Nothing
Set myitem = Application.ActiveInspector.CurrentItem
initialSubj = myitem.Subject
initialBod = myitem.Body
finalSubj = ????????????????????????????
finalBody = "Hello Team," + vbCrLf + "resend was successful" + vbCrLf & CStr(initialBod)
myitem.Subject = finalSubj
myitem.Body = finalBody
End Function
Function GetCurrentItem() As Object
Dim objApp As Outlook.Application
Set objApp = Application
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = _
objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = _
objApp.ActiveInspector.CurrentItem
Case Else
End Select
End Function
采纳答案by niton
finalSubj = ParseTextLinePair(initialBod, "Mailbox:")
See "Listing 17.1. Extract data from a structured text block". https://docs.microsoft.com/en-us/previous-versions/office/developer/office-2007/dd492012(v=office.12)
参见“清单 17.1. 从结构化文本块中提取数据”。https://docs.microsoft.com/en-us/previous-versions/office/developer/office-2007/dd492012(v=office.12)
Function ParseTextLinePair(strSource As String, strLabel As String)
Dim intLocLabel As Integer
Dim intLocCRLF As Integer
Dim intLenLabel As Integer
Dim strText As String
' locate the label in the source text
intLocLabel = InStr(strSource, strLabel)
intLenLabel = Len(strLabel)
If intLocLabel > 0 Then
intLocCRLF = InStr(intLocLabel, strSource, vbCrLf)
If intLocCRLF > 0 Then
intLocLabel = intLocLabel + intLenLabel
strText = Mid(strSource, _
intLocLabel, _
intLocCRLF - intLocLabel)
Else
intLocLabel = Mid(strSource, intLocLabel + intLenLabel)
End If
End If
ParseTextLinePair = Trim(strText)
End Function
Note: The OP indicated the line that worked was
注意：OP 表示有效的行是
finalSubj = ParseTextLinePair((CStr(initialBod)), "Mailbox:")
