当前打开电子邮件

Question

工作，我想获得主动打开的MailItem（不管它是一个新的邮件或接收邮件）。当用户运行我的宏时，我需要向该邮件添加一些内容。我使用的是Outlook 2003和VBA。

我找到了这个：How do you get a reference to the mail item in the current open window in Outlook using VBA?它不起作用，因为TypeName(Application.ActiveWindow)被设置为空。我也试过Set Mail = Application.ActiveInspector.currentItem，但它也不起作用。

一定有什么东西我不明白有关ActiveInspector事情。

按照要求，这是程序/宏位于专用模块，当一个菜单按钮，用户点击Application_Startup()方法添加了名为：

Sub myMacro() 
    Dim NewMail As Outlook.MailItem 
    Set NewMail = Application.ActiveInspector.currentItem 
End Sub 

Answer 1

我不知道到底你的代码有什么问题。但是，首先，你并没有确认一个新的，可编辑的电子邮件甚至是开放的。下面的概念证明完全符合我认为你想要做的事情：在正在编写的活动电子邮件中插入一些文本。如果这是不可能的，它会显示一个消息框来解释原因。

该插入如果Word被用作电子邮件编辑器（其将ALWAYS be the case in Outlook 2010+）文本只会工作的部分。如果不是，您将不得不直接解析和更新Body或HTMLBody文本。

Sub InsertText() 
    Dim myText As String 
    myText = "Hello world" 

    Dim NewMail As MailItem, oInspector As Inspector 
    Set oInspector = Application.ActiveInspector 
    If oInspector Is Nothing Then 
     MsgBox "No active inspector" 
    Else 
     Set NewMail = oInspector.CurrentItem 
     If NewMail.Sent Then 
      MsgBox "This is not an editable email" 
     Else 
      If oInspector.IsWordMail Then 
       ' Hurray. We can use the rich Word object model, with access 
       ' the caret and everything. 
       Dim oDoc As Object, oWrdApp As Object, oSelection As Object 
       Set oDoc = oInspector.WordEditor 
       Set oWrdApp = oDoc.Application 
       Set oSelection = oWrdApp.Selection 
       oSelection.InsertAfter myText 
       oSelection.Collapse 0 
       Set oSelection = Nothing 
       Set oWrdApp = Nothing 
       Set oDoc = Nothing 
      Else 
       ' No object model to work with. Must manipulate raw text. 
       Select Case NewMail.BodyFormat 
        Case olFormatPlain, olFormatRichText, olFormatUnspecified 
         NewMail.Body = NewMail.Body & myText 
        Case olFormatHTML 
         NewMail.HTMLBody = NewMail.HTMLBody & "<p>" & myText & "</p>" 
       End Select 
      End If 
     End If 
    End If 
End Sub 

Answer 2

您是不是要选择当前所选的讯息？在这种情况下，你需要使用Application.ActiveExplorer.Selection收藏，不Application.ActiveInspector.CurrentItem。

Answer 3

  ' 
      Dim myOlExp As Outlook.Explorer 
      Dim myOlSel As Outlook.Selection 

      Set myOlExp = Application.ActiveExplorer 
      Set myOlSel = myOlExp.Selection 
      'MsgBox myOlSel.item(1) 


      Dim selectedFolder As Outlook.MAPIFolder 
       Set selectedFolder = myOlExp.CurrentFolder 
      Dim itemMessage As String 
       itemMessage = "Item is unknown." 


      Dim expMessage As String 
      expMessage = "Your current folder is " & selectedFolder.Name & "." & vbCrLf 

      If myOlSel.Count > 0 Then 

          Dim selObject As Object 
          Set selObject = myOlSel.item(1) 

          If (TypeOf selObject Is Outlook.mailItem) Then 
           Dim mailItem As Outlook.mailItem 
           Set mailItem = selObject 
           itemMessage = "The item is an e-mail message." & " The subject is " & mailItem.Subject & "." 
           mailItem.Display (False) 

          ElseIf (TypeOf selObject Is Outlook.contactItem) Then 
           Dim contactItem As Outlook.contactItem 
           Set contactItem = selObject 
           itemMessage = "The item is a contact." & " The full name is " & contactItem.Subject & "." 
           contactItem.Display (False) 

          ElseIf (TypeOf selObject Is Outlook.AppointmentItem) Then 
           Dim apptItem As Outlook.AppointmentItem 
           Set apptItem = selObject 
           itemMessage = "The item is an appointment." & apptItem.Subject & "." 

          ElseIf (TypeOf selObject Is Outlook.taskItem) Then 
           Dim taskItem As Outlook.taskItem 
           Set taskItem = selObject 
           itemMessage = "The item is a task." & " The body is " & taskItem.Body & "." 
          ElseIf (TypeOf selObject Is Outlook.meetingItem) Then 
           Dim meetingItem As Outlook.meetingItem 
           Set meetingItem = selObject 
           itemMessage = "The item is a meeting item. " & "The subject is " & meetingItem.Subject & "." 
          End If 
         End If 
         expMessage = expMessage & itemMessage 
        MsgBox (expMessage) 
      End Sub