如何将约会正文（包括所有格式）复制到电子邮件？

Question

为了每周自动向我的团队发送一封电子邮件，我关注了this post（但我对其他任何事情都持开放态度。每周都会提醒他们完成某事）。

使用约会和 VBA 子程序将约会内容作为邮件内容发送。

但约会的正文包括：

• 要点
• 文件的超链接

这是我想要的电子邮件格式：

采用了一些格式，但没有提到提到的两点。

收到的截图：

如何获得完整格式？

Private Sub Application_Reminder(ByVal Item As Object)
    Dim objMsg As MailItem
    Set objMsg = Application.CreateItem(olMailItem)

    If Item.MessageClass <> "IPM.Appointment" Then 'vérifie s'il s'agit d'un rappel sur RDV
        Exit Sub
    End If

    If (Item.Categories <> "00.CourrielsAutomatiques") Then 'indiquer ici le nom de la catégorie créée pour les mails autos
        Exit Sub
    End If
    objMsg.SendUsingAccount = objMsg.Session.Accounts.Item(1) 'si gestion de plusieurs comptes
    objMsg.To = Item.Location 'ligne Lieu de rendez-vous utilisée pour les adresses
    objMsg.Subject = Item.Subject 'objet du mail
    objMsg.HTMLBody = Item.Body  'corps du mail
    'objMsg.Attachments.Add "C:\Users\xxx\Desktop\xxx.jpg" 'pour ajouter une pièce jointe
    objMsg.Send

    Set objMsg = Nothing
End Sub

Answer 1

Option Explicit

Private Sub copyApptBodyWithFormatting()
  
    Dim olItem As Object
    Dim olItemInspector As Inspector
    Dim olItemWordEditor As Object
    
    Dim olMail As MailItem
    Dim olMailInspector As Inspector
    Dim olMailWordEditor As Object
    
    Set olItem = ActiveInspector.currentItem
    
    If olItem.Class = olAppointment Then
        
        Set olItemInspector = olItem.GetInspector
        Set olItemWordEditor = olItemInspector.WordEditor
        olItemWordEditor.Range.Copy
        
        Set olMail = CreateItem(olMailItem)
          
        With olMail
        
            .Display
            
            Set olMailInspector = .GetInspector
            Set olMailWordEditor = olMailInspector.WordEditor
            
            olMailWordEditor.Range(0, 0).Paste
            
        End With
        
    End If

End Sub

---

Private Sub Application_Reminder(ByVal Item As Object)

    Dim itemInspector As Inspector
    Dim itemWordEditor As Object
    
    Dim objMsg As MailItem
    Dim objMsgInspector As Inspector
    Dim objMsgWordEditor As Object
    
    If Item.MessageClass <> "IPM.Appointment" Then 'vérifie s'il s'agit d'un rappel sur RDV
        Exit Sub
    End If

    If (Item.categories <> "00.CourrielsAutomatiques") Then 'indiquer ici le nom de la catégorie créée pour les mails autos
        Exit Sub
    End If
    
    Set objMsg = CreateItem(olMailItem)
    
    objMsg.SendUsingAccount = objMsg.Session.Accounts.Item(1) 'si gestion de plusieurs comptes
    objMsg.To = Item.Location 'ligne Lieu de rendez-vous utilisée pour les adresses
    objMsg.subject = Item.subject 'objet du mail
    
    'objMsg.HTMLBody = Item.body  'corps du mail
    Set itemInspector = Item.GetInspector
    Set itemWordEditor = itemInspector.WordEditor
    itemWordEditor.Range.Copy
    
    objMsg.Display
    
    Set objMsgInspector = objMsg.GetInspector
    Set objMsgWordEditor = objMsgInspector.WordEditor
    objMsgWordEditor.Range(0, 0).Paste

    'objMsg.Send

End Sub