使用包含文本的正文的第一行填充电子邮件的主题行

Question

我办公室的团队花费大量时间将一篇文章的第一行复制粘贴到正文中，然后粘贴到主题行中。

我找到了一个解决方案，将正文的第一行设置为主题。
问题是正文的第一行文本上方总是有两到三个空白行。 解决方案设置主题为" ".

有没有办法删除顶部的空行，或者跳过它们并将主题设置为文本的第一行？

DataNumen 的 Shirley Zhang 提供了代码。

我一直在使用的 VBA 代码：

Private WithEvents objInspectors As Outlook.Inspectors

Private Sub Application_Startup()
   Set objInspectors = Outlook.Application.Inspectors
End Sub

Private Sub objInspectors_NewInspector(ByVal Inspector As Inspector)
    If Inspector.CurrentItem.Class = olMail And Inspector.CurrentItem.subject = "" Then
       Inspector.CurrentItem.subject = " "
    End If
End Sub

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim objMail As Outlook.MailItem
Dim objMailDocument As Word.Document
Dim objMailSelection As Word.Selection

If TypeOf Item Is MailItem Then
    Set objMail = Item

    If Len(Trim(objMail.subject)) = 0 Then
        Set objMailDocument = objMail.GetInspector.WordEditor
        Set objMailSelection = objMailDocument.Application.Selection

        objMailDocument.Range(0, 0).Select
        objMailSelection.MoveEnd wdLine

        'Take first line of body as subject
        objMail.subject = objMailSelection.Text
    End If
End If
End Sub

Answer 1

试试这个：

If Len(Trim(objMail.subject)) = 0 Then
     'Take first line of body as subject
     objMail.subject = FirstLineOfText(objMail.GetInspector.WordEditor)
End If

返回第一行文本的函数：

Function FirstLineOfText(doc As Word.Document)
    Dim p As Word.Paragraph, rng
    For Each p In doc.Paragraphs
        'Find the first paragraph with content
        If Len(p.Range.Text) > 2 Then
            'select the start point of the paragraph
            doc.Range(p.Range.Start, p.Range.Start).Select
            'extend the selection to include the whole line
            doc.Application.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
            FirstLineOfText = Trim(doc.Application.Selection.Text) '<<EDITED
            Exit Function
        End If
    Next p
End Function

Answer 2

试一试：

If TypeOf Item Is MailItem Then
   Set objMail = Item

   If Len(Trim(objMail.Subject)) = 0 Then
       Set objMailDocument = objMail.GetInspector.WordEditor
       Set objMailSelection = objMailDocument.Application.Selection

       objMailDocument.Range(0, 0).Select
       objMailSelection.MoveEnd wdLine

       'Loop until we find some text
       Do While objMailSelection.Text = ""
          objMailSelection.MoveEnd wdLine
       Loop

       'Take first line of body as subject
       objMail.Subject = objMailSelection.Text
   End If
End If

Answer 3

您是否尝试过使用Regular Expression (regex or regexp for short)

https://regex101.com/r/msJ13L/2

---

"^\w(.*)$"

^ 在行首断言位置

\w 匹配任何单词字符（等于 [a-zA-Z0-9_]）

第一捕获组(.*)

.* 匹配任何字符（行终止符除外）

* 量词 - 匹配零次到无限次，尽可能多次，按需回馈（贪婪）

$ 在行尾声明位置 全局模式标志

m 修饰符：多行。导致 ^ 和 $ 匹配每行的开始/结束（不仅是字符串的开始/结束）

---

VBA 示例

Option Explicit
Public Sub Example()
    Dim Matches As Variant        
    Dim Item As MailItem
    Set Item = ActiveExplorer.selection(1)

    Dim RegExp As Object
    Set RegExp = CreateObject("VbScript.RegExp")

    Dim Pattern As String
    Pattern = "^\w(.*)$"
    With RegExp
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        .Pattern = Pattern
         Set Matches = .Execute(Item.Body)
    End With

    If Matches.Count > 0 Then
        Debug.Print Matches(0) ' Print on Immediate Window
    Else
        Debug.Print "Not Found "
    End If

    Set RegExp = Nothing
End Sub