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

您是否尝试过使用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

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

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

3 个答案: