Using Outlook.Application.ActiveInspector.CurrentItem in VSTO - vb.net

I have an Outlook macro and I'm working to convert it to a com add in to make deployment easier. This is my first attempt at doing this and I am using VSTO 2013. When I copy over the code I'm using in my macro, it doesn't like the "Outlook.Application.ActiveInspector.CurrentItem" as I get an error: "Reference to a non-shared member requires an object reference."
The code I am using is listed below.
Sub InsertSubject()
Dim objMsg As Outlook.MailItem
'Get the currently open message'
Set objMsg = Outlook.Application.ActiveInspector.CurrentItem
objMsg.Subject = objMsg.Subject & "(Secure) "
'Destroy the object to avoid memory leaks'
objMsg.Send
Set objMsg = Nothing
End Sub
Can anyone give me some tips on how to use the currently selected item item in VB? Sorry if this comes aross as a "teach me how to code" question. I am new to this and just learn better when I have a real world problem to work through.

I was actaully able to piece the following together and get this to work.
Dim _item As Outlook.MailItem = Globals.ThisAddIn.Application.ActiveInspector().CurrentItem
Dim objMsg As Outlook.MailItem
'Get the currently open message'
objMsg = Globals.ThisAddIn.Application.ActiveInspector().CurrentItem
objMsg.Subject = objMsg.Subject & "(Secure) "
'Destroy the object to avoid memory leaks'
objMsg.Send()
objMsg = Nothing

Related

GetSharedDefaultFolder - Subfolder Access Error

I am having trouble getting my Outlook VBA code to recognize the subfolder in my Shared Tasks.
What I'm trying to do is create a macro that will automatically create a task in the department Shared Task folder. Tried Googling a variety of solutions to no avail. The code goes as follows:
Dim objApp As Outlook.Application
Dim defaultTasksFolder As Outlook.MAPIFolder
Dim subFolder As Outlook.MAPIFolder
Dim objNS As Outlook.NameSpace
Dim objMail As MailItem
Dim objItm As TaskItem
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objMail = Outlook.Application.ActiveExplorer.Selection.Item(1)
Dim objOwner As Outlook.Recipient
Set objOwner = objNS.CreateRecipient("name#email.com")
objOwner.Resolve
If objOwner.Resolved Then
Set defaultTasksFolder = objNS.GetSharedDefaultFolder(objOwner, olFolderTasks)
subFolder = defaultTasksFolder.Folders("TestFolder") **ERROR OCCURS HERE - OBJECT COULD NOT BE FOUND**
Set objItm = subFolder.Items.Add(olTaskItem)
With objItm
.Subject = "Name- " & objMail.Subject
.StartDate = objMail.ReceivedTime
.Body = objMail.Body
End With
objItm.Save
MsgBox ("Task Created for e-mail: " & vbCrLf & objMail.Subject)
End If
End Sub
It errors out on subFolder = defaultTasksFolder.Folders("TestFolder"), saying that the object could not be found. I double and tripled checked the folder name.
Any ideas what might be causing this error? Thank you!!
First of all, add the Logon method before accessing MAPI, it will log to the profile if Outlook has just been started. If it is already running it will not affect anything. Then try to add both mailboxes as delegate stores (see the Advanced tab of the Exchange account properties dialog). You should see both mailboxes.
Finally, I'd try to iterate over all folders before to make sure the folder exists. Also, I'd recommend checking the recipient's name.
Keep in mind that Outlook might cache only the default folders, but not their suborders.
Can you see and access the subfolder in Outlook?

VBA Outlook - Some MailItems produce runtime error 430

I am currently working on a simple VBA macro wich collects some metadata (e.g. EntryId, ReceivedTime, Recipients etc...) of mails in an Outlook mailbox.
To accomplish this it iterates through all folders recursively and collects the data from MailItems in every folder.
But I'm getting errors, which are not restricted to the same object (sometimes the error pops up earlier, but never later), stating the object does not support automation (runtime error 430).
The strange thing is, that roughly 14000 MailItems are processed without failure and usually at number 14232 it crashes.
I have two questions regarding this error:
I am working on a non local mailbox, therefore only a part of the data should be cached in the local .ost file.Could data missing in the cache be the cause for the error?
And if the cache is not the problem, then what is wrong with my code?
A simplified version of the code:
(Please note that all non MailItem objects are ruled out via an explicit typecheck)
Sub cache()
Dim objOl As Outlook.Application
Dim objNs As Outlook.NameSpace
Dim folder As Outlook.MAPIFolder
Dim vFolders As Outlook.Folders
Set objOl = New Outlook.Application
Set objNs = objOl.GetNamespace("MAPI")
Set vFolders = objNs.Folders
'This is where we're looking for the mailbox to work with
For i = 1 to vFolders.count
If StrComp(vFolders(i), "The Mailbox") = 0 Then
walk vFolders(i)
End If
Next
End Sub
Sub walk(folder As Outlook.MAPIFolder)
Dim item As Object
Dim vItems As Outlook.Items
Set vItems = folder.Items
If vItems.count > 0 Then
For i = 1 to vItems.Count
Set item = vItems(i)
If item.class = 43 Then
'This is where the debugger shows the runtime error 430
Debug.Print item.EntryID & vbCrLf & item.ReceivedTime
End If
Next
End If
Dim vFolders as Outlook.Folders
Set vFolders = folder.Folders
If (vFolders.count > 0) Then
For i = 1 To vFolders.Count
walk vFolders(i)
Next
End If
End Sub
UPDATE:
I updated the code according to the suggestions. No multi-dot notation and no For Each loops, the performance increased but the problem keeps occuring at the exact same item, as soon as I try to access data like (subject, entryID or else).
Since your error is happening in the same mailitem every time, I would validate what item 14232 is. From my experience just because it validates as enum 43 (or olMail) doesn't mean that all of the data will be valid. Is there anything special about 14232?
Edit:
I am currently working on a project using vb and outlook mailitems. I just identified the Item.MessageClass property defines the sub mailitem type. When I attempt to cast a message with a MessageClass other than IPM.Note it will give me a 430 error. Some of the MessageClass values that have given me problems include IPM.Note.Rues.ReplyTemplate.Microsoft and IPM.Note.Rules.OofTemplate.Microsoft. When I break on these messages I can see that most of the item's properties are not available. I would add an if check on your loop like this:
If item.class = 43 then
If item.messageclass = "IPM.Note" Then
Debug.Print item.EntryID & vbCrLf & item.ReceivedTime
End If
End If
this will then only print the info for normal messages. You may want to do some debugging on the MessageClass properties that you are currently able to process and see if they are all IPM.Note or if you can pinpoint the sub-type that is causing your problem.
Note: I do see that these mailitems still have a valid EntryID and ReceivedTime so I am not sure what the problem might be. What line of the code is your error occurring? The assignment of vItems(index) to Item? or is it somewhere else?
Firstly, avoid using multiple dot notation. Secondly, try not to use "for each" loops - they keep the collection items referenced until the loop exits. Do not use MailItem.Close - it does nothing unless you are actually showing the item in an Inspector.
dim vItems as Outlook.Items
vItems = folder.Items
for I = 1 to vItems.Count
set item = vItems.Item(I)
if item.Class = 43 Then
Debug.Print item.EntryID & vbCrLf & item.ReceivedTime
End If
set item = Nothing
Next

How to access certain mailitem properties/methods in a Visual Studio Outlook Add-In?

I'm developing an Outlook (2010) add-in using Visual Studio 2013 (Targeting .NET 4).
Certain Outlook properties/methods seem to be unavailable.
The following code works from Outlook VBA.
Public Sub OutlookTest()
'Dim oApp As New Outlook.Application (NOT NEEDED FOR OUTLOOK VBA)
Dim oExp As Outlook.Explorer
Dim oSel As Outlook.Selection ' You need a selection object for getting the selection.
Dim oItem As Object ' You don't know the type yet.
Set oExp = Application.ActiveExplorer 'Get the ActiveExplorer.
Set oSel = oExp.Selection ' Get the selection.
For i = 1 To oSel.Count ' Loop through all the currently .selected items
Set oItem = oSel.Item(i) ' Get a selected item.
Call DisplayInfo(oItem) ' Display information about it.
Next i
End Sub
Private Sub DisplayInfo(oItem As Object)
Dim strMessageClass As String
Dim oMailItem As Outlook.MailItem
' You need the message class to determine the type.
strMessageClass = oItem.MessageClass
If (strMessageClass = "IPM.Note") Then ' Mail Entry.
Set oMailItem = oItem
MsgBox oMailItem.Subject
MsgBox oMailItem.EntryID
MsgBox oMailItem.HTMLBody
oMailItem.SaveAs "C:\Users\u001tb7\Desktop\New folder\testOL.msg", olMSG
Else
MsgBox "Pick something else"
End If
End Sub
When I try near identical code from Visual Studio in an add-in:
Private Sub butSettings_Click(sender As Object, e As RibbonControlEventArgs) Handles butSettings.Click
Dim oApp As New Outlook.Application
Dim oExp As Outlook.Explorer
Dim oSel As Outlook.Selection ' You need a selection object for getting the selection.
Dim oItem As Object ' You don't know the type yet.
oExp = oApp.ActiveExplorer ' Get the ActiveExplorer.
oSel = oExp.Selection ' Get the selection.
For i = 1 To oSel.Count ' Loop through all the currently .selected items
oItem = oSel.Item(i) ' Get a selected item.
DisplayInfo(oItem) ' Display information about it.
Next i
End Sub
Sub DisplayInfo(oItem As Object)
Dim strMessageClass As String
Dim oMailItem As Outlook.MailItem
' You need the message class to determine the type.
strMessageClass = oItem.MessageClass
If (strMessageClass = "IPM.Note") Then ' Mail Entry.
oMailItem = oItem
MsgBox(oMailItem.Subject)
MsgBox(oMailItem.EntryID)
MsgBox(oMailItem.HTMLBody) '<---FAILS
oMailItem.SaveAs("C:\Users\u001tb7\Desktop\New folder\testVS.msg", Outlook.OlSaveAsType.olMSG) '<---ALSO FAILS
Else
MsgBox("Pick something else")
End If
End Sub
I get an error on MailItem.HTMLBody and MailItem.SaveAs but NOT MailItem.Subject or .EntryID.
This makes me suspect it's something to do with the security, as I think properties like .HTMLBody are 'protected', but .EntryID and .Subject are not.
The error is the generic COM exception not giving me any detail:
An exception of type 'System.Runtime.InteropServices.COMException' occurred in MsgSave.dll but was not handled in user code
Additional information: Operation aborted (Exception from HRESULT: 0x80004004 (E_ABORT))
Is there any way to get Outlook to 'trust' my VS code (for eventual distribution)? Or is there something else amiss?
EDIT: Thanks to both below!
Instead of:
Dim oApp As New Outlook.Application
Use:
Dim oApp as Outlook.Application = Globals.ThisAddIn.Application
Do not use New Outlook.Application in an Outlook addin - you get Outlook.Application object for free when your addin starts up.
certain outlook properties/methods seem to be unavailable
What properties are you talking about? Could you be more specific?
As Dmitry suggested, you need to use the Application property provided by VSTO. In that case you will avoid security prompts or exceptions. Typically you get such issue when you try to automate Outlook from a standalone application. The Application object provided by VSTO is trusted and doesn't generate exceptions for secured properties or methods (for example, MailItem.Send). You can read more about that in the Outlook "Object Model Guard" Security Issues for Developers article.

Appening to Subject and Send message Outlook VBA

I'm trying to create a macro that will add some text into the subject of a message and then send the message. I ahve created a button on the ribbon that the user will click to add (Secure) into the subject line and send the message.
I'm using the following which I've put together from several sources I found online.
Sub InsertSubject()
Dim objMsg As Outlook.MailItem
'Get the currently open message'
Set objMsg = Outlook.Application.ActiveInspector.CurrentItem
objMsg.Subject = CurrentItem.Subject & "(Secure) "
'Destroy the object to avoid memory leaks'
objMsg.Send
Set objMsg = Nothing
End Sub
when I run this I get a Run-time error 424 Object Required. It appears to have an issue with the following line
objMsg.Subject = CurrentItem.Subject & "(Secure) "
If I remove the CurrentItem.Subject, the code works but obviously just replaces what ever subject with (Secure).
Any help would be greatly appreciated.
I think you are intending to do objMsg.Subject = objMsg.Subject & "(Secure) ".
Note that you are trying to use CurrentItem which is not necessarily the same as Outlook.Application.ActiveInspector.CurrentItem. I'm not that familiar with Outlook object model but I bet CurrentItem when called on it's own is not valid.

Suppress dialog warning that a program is trying to access my mails

I am following the code from this page: How to create a script for the Rules Wizard in Outlook
This is what I have:
Public Sub GetMails(Item As Outlook.MailItem)
MsgBox "Mail message arrived: " & Item.SenderEmailAddress
MsgBox "Mail message arrived: " & Item.Subject
MsgBox "Mail message arrived: " & Item.Body
End Sub
I set a rule to run this macro. Every time this script runs there is a dialog about how a program is trying to access my mails.
How can I get rid of this using VBA or is there any configuration option in Outlook so that this does not appear?
I have googled for this and found some sites giving code for C# and VB.net but none for VBA.
This was added to prevent malicious scripts from turning Outlook into a mass mailer or other bad things.
You can turn this off on your workstation, but if you want to distribute your application to other users, you can get rid of this only by creating your own Outlook Addin or use a 3rd-party tool like Redemption.
Try this
Tools-->Macro-->Security-->macro security-->No security
Tools-->Macro-->Security-->Programmatic Access
Then choose Never warn me about suspicious activity.
I found this somewhere and it works:
Sub SaveAttachment(myItem As Outlook.MailItem)
' Remove ay attachments for the email and save them in a
' local folder. If there are any erros on the saveing then
' attachments are left in place.
Dim myAttachments As Object
Dim myOrt As String
Dim strID As String
Dim olNS As Outlook.NameSpace
Dim oMail As Outlook.MailItem
Dim fs As Object
' We need to get the mail item object from the application
' object to avoid warning messages
strID = myItem.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set oMail = olNS.GetItemFromID(strID)