在 Outlook 正文中搜索结构化文本 [英] Search structured text in Outlook body

问题描述

我需要在选定的邮件中找到一行并复制它.

I need to find a line in a selected mail and copy it.

该行包含

邮箱:??????????????????

Mailbox: ????????????????

那一行的符号数不同

邮件看起来有点像这样

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 = "lol@.herp.com"
    oMail.To = "lol@.herp.com"
    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 = "[e-mail]"
    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

推荐答案

finalSubj = ParseTextLinePair(initialBod, "Mailbox:")

参见清单 17.1. 从结构化文本块中提取数据".https:///docs.microsoft.com/en-us/previous-versions/office/developer/office-2007/dd492012(v=office.12)

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)

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

注意:OP 指出有效的行是

Note: The OP indicated the line that worked was

finalSubj = ParseTextLinePair((CStr(initialBod)), "Mailbox:") 

这篇关于在 Outlook 正文中搜索结构化文本的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！