将短签名+日期添加到现有文本段落并格式化整行

Add short signature + date to an existing paragraph of text and format the whole line

问题:

我想输入一段文字,添加我的简短签名 + 日期 + 时间并格式化所有内容,以便其他人可以看到我将此评论添加到邮件中。

示例:

这是我对该主题的个人评论 // Signature Tom, 22.08.21, 14:00(<- 通过 VBA 添加最后一部分 - 代码并将整个段落用红色和斜体 VBA)
尊敬的先生或女士
...-> 邮件正文
此致

我有什么

到目前为止,它是两个独立的 VBA 子例程,我通过网络反复试验设法创建了它,但我希望一步到位(因为我必须一次又一次地调用它们) .

第一名:

Option Explicit
Public Sub AddShortSignature()
    Dim xDoc As Object
    Dim xSel As Object
    
    On Error Resume Next
    Select Case TypeName(Application.ActiveWindow)
        Case "Explorer"
            Set xDoc = Application.ActiveExplorer.Selection(1).GetInspector.WordEditor
        Case "Inspector"
            Set xDoc = Application.ActiveInspector.WordEditor
    End Select
    
    Set xSel = xDoc.Application.Selection
    xSel.InsertBefore Format(Now, "DD/MM/YYYY hh/mm")
    xSel.InsertBefore Format(" // Tom., ")
    
    Set xDoc = Nothing
    Set xSel = Nothing
    
    SendKeys "{End}", True
    SendKeys "+{Home}", True

End Sub

第二,根据我的喜好格式化所有内容:

Sub formateverything()

    Dim objDoc As Object
    Dim objSel As Object
    
    Set objDoc = ActiveInspector.WordEditor
    Set objSel = objDoc.Windows(1).Selection

    objSel.Font.Name = "Arial"
    objSel.Font.Italic = True
    objSel.Font.Bold = False
    objSel.Font.Underline = False
    objSel.Font.Color = RGB(0, 0, 0)
    objSel.Font.Size = 14
    
End Sub

此代码将光标设置到消息字段的结束位置,并插入一个'signature'。有了这个,你可以设置任何你想要的位置。

Public Sub OutlookMail_SetCursorAT()
    Dim Ins As Outlook.Inspector
    Dim Doc As Object
    Dim Range As Object
    Dim Pos As Long
    
    Set Ins = Application.ActiveInspector
    Set Doc = Ins.WordEditor
    
    ' Set the cursor to the end position of the message field
    If Not Doc Is Nothing Then
        Pos = Doc.Range.End - 1
        Set Range = Doc.Range(Pos, Pos)
        Range.Select
    End If
    
    ' Signature
    Dim mySignature As String
    mySignature = vbCrLf & Format(" // Tom., ")
    mySignature = mySignature & vbCrLf & Format(Now, "DD/MM/YYYY hh/mm")
    
    Range.InsertAfter mySignature
End Sub

正如我在你的照片中看到的那样,你的评论和签名出现在邮件的顶部(第一段),所以这就是我想出的。

Public Sub OutlookMail_CommentAndSignature()
    Dim Ins As Outlook.Inspector
    Dim Doc As Object
    Dim mySignature As String
    Dim oPara As Object         ' paragraph
    Dim paraText As String      ' paragraph text
    Dim paraLength As Integer   ' paragraph length
    
    Set Ins = Application.ActiveInspector
    Set Doc = Ins.WordEditor
    
    ' Signature
    mySignature = " // Tom., " & Format(Now, "DD/MM/YYYY hh:mm") & vbCrLf

'    ' First paragraph: comment + signature
'    Set oPara = Doc.Paragraphs(1).Range
'    paraLength = Len(oPara.Text)
'    oPara.Text = Left(oPara.Text, paraLength - 1)   ' without vbCrLf
'    oPara.Text = oPara.Text & mySignature

'    ' format first paragraph
'    oPara.Font.Italic = wdToggle
'    oPara.Font.ColorIndex = wdRed
    
    ' Selected text
    Dim selRange As Object: Set selRange = Doc.Application.Selection.Range

    ' set text range to italic and red
    selRange.InsertAfter mySignature

    ' format first paragraph
    selRange.Font.Italic = wdToggle
    selRange.Font.ColorIndex = wdRed
End Sub