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:
13522


Popped in:
13523

[skatonni]

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

https://msdn.microsoft.com/en-us/library/office/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/library/office/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