用正文的第一行填充電子郵件的主題行

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