Заполнение строки темы письма первой строкой его тела

Question

Команда в моем офисе тратит много времени, копируя и вставляя первую строку статьи в тело и вставляя ее в строку темы.

Я нашел решение, которое берет первую строку тела и устанавливает ее в качестве субъекта.

Проблема в том, что всегда есть две-три пустых строки над первой строкой текста в теле.Решение все еще работает, но оно устанавливает тему как " ".

Есть ли способ либо удалить пустые строки вверху, либо пропустить их и установить тему в качестве первой строки текста (исключаяпробелы)?

Заранее благодарю за помощь, вы действительно поможете команде и сделаете стажера (меня) очень счастливым.

Большое спасибо Ширли Чжан из DataNumen, предоставившей код.

Вот код 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

Вы пытались использовать Регулярное выражение (регулярное выражение или сокращенное выражение)

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

---

"^\w(.*)$"

^ устанавливает положение в начале строки

\w соответствует любому символу слова (равен [a-zA-Z0-9 _])

1-я группа захвата (.*)

.* соответствует любому символу (кроме ограничителей строки)

* Квантификатор - сопоставляется от нуля до неограниченного числа раз столько раз, сколько возможно, возвращая при необходимости (жадный)

$ устанавливает положение в конце строки Глобальные флаги шаблонов

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 2

Попробуйте это:

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 3

Дайте этому шанс:

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