用正文的第一行填充电子邮件的主题行

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 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 2

您是否尝试过使用正则表达式（简称 regex 或 regexp）

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

Answer 3

尝试这个：

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