Outlook 2013 script changing msg options for "popped in" emails

[greglittle]

Hi everyone, I could do with a little help. With Outlook 2013, how do you change message options for an email that you are writing "popped in" to the Message Preview area?

I wrote a VBA macro a few years ago that would apply a specific label to any draft email it was executed on. Long story short: I was frequently forgetting attachments or wanting to add/change email text right after pushing the send button. By writing this macro, I could use a system-wide rule to delay sending all email by x minutes, and then for those cases where I for sure needed the email send out right away I would apply the macro (placed in a button at the top of the message window). When I [finally] switched to Outlook 2013 last week--I downgraded the first time I switched b/c I hated it, but now my company made me do it--my macro works for draft emails that are "popped out" in their own windows, but not those "popped in" to the Message Preview area.

Since the script uses the objApp.ActiveInspector.CurrentItem call, I would think it should be able to identify the "popped in" draft email window as the CurrentItem, but it doesn't. The macro displays the "Category Applied" MsgBox, but it doesn't actually apply the category.

Please help... this is baffling me, and it's probably something stupid that I'm not seeing. Thanks!


Here is my script:

Sub InstantSend()
  Call MarkWithCategory("Instant Send")
End Sub


Sub MarkB()
  Call MarkWithCategory("B")
End Sub


Sub MarkWithCategory(strCat As String)
  Dim objItem As Object
  Set objItem = GetCurrentItem()
  If Not objItem Is Nothing Then
    objItem.Categories = objItem.Categories & "," & strCat
    objItem.Save
    MsgBox "        Category Applied:" & vbCrLf & "             " & strCat
  End If
  Set objItem = Nothing
End Sub


Function GetCurrentItem() As Object
  Dim objApp As Outlook.Application
  Set objApp = CreateObject("Outlook.Application")
  On Error Resume Next
  Select Case TypeName(objApp.ActiveWindow)
    Case "Explorer"
      Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
    Case "Inspector"
      Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
    Case Else
  End Select
  Set objApp = Nothing
End Function

Popped out:
Popped out.jpg


Popped in:
Popped in.jpg

[skatonni]

I do not have 2013 so I can only suggest you try "Application.ActiveExplorer.ActiveInlineResponse"

https://msdn.microsoft.com/en-us/lib.../jj231535.aspx

As a side note you can simply use Application rather than objApp if your code is in Outlook.

[greglittle]

I do not have 2013 so I can only suggest you try "Application.ActiveExplorer.ActiveInlineResponse"

https://msdn.microsoft.com/en-us/lib.../jj231535.aspx

As a side note you can simply use Application rather than objApp if your code is in Outlook.

That did it! Thank you... I knew it was something simple that I was missing. Really appreciate it.

[greglittle]

Here's the final code for if anyone wants to add labels to an email... now works on replies within the explorer window and popped out.

Sub InstantSend()
    Call MarkWithCategory("Instant Send") 
End Sub 
 
 
Sub MarkB() 
    Call MarkWithCategory("B") 
End Sub 
 
 
Sub MarkWithCategory(strCat As String) 
    Dim objItem As Object 
    Set objItem = GetCurrentItem() 
    If Not objItem Is Nothing Then 
        objItem.Categories = objItem.Categories & "," & strCat 
        objItem.Save 
        MsgBox "        Category Applied:" & vbCrLf & "             " & strCat 
    End If 
    Set objItem = Nothing 
End Sub 
 
 
Function GetCurrentItem() As Object 
    Dim objApp As Outlook.Application 
    Set objApp = CreateObject("Outlook.Application") 
    On Error Resume Next 
    Select Case TypeName(objApp.ActiveWindow) 
    Case "Explorer" 
        Set GetCurrentItem = objApp.ActiveExplorer.ActiveInlineResponse 
    Case "Inspector" 
        Set GetCurrentItem = objApp.ActiveInspector.CurrentItem 
    Case Else 
    End Select 
    Set objApp = Nothing
End Function