Get selected mail items in Outlook Explorer with VB.Net - vb.net

I am trying to convert some VBA code I have put together into an Outlook addin in order to avoid having to run the macros in reduced security environment.
I know just enough VBA and VB6 to dabble in writing stuff I use for myself and this is my first foray into VB.Net.
I just installed Visual Studio (Community Edition) and the conversion from VBA to has gone smoother than I expected thanks to suggestions by the IDE apart from one or two issues.
One of these is trying to get the items selected in Outlook which I had based on the code provided here: https://msdn.microsoft.com/en-us/library/office/ff868001.aspx
Sub GetSelectedItems()
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Dim oMail As Outlook.MailItem
Dim x As Integer
myOlExp = Application.ActiveExplorer ' => This generates an error
myOlSel = myOlExp.Selection
For x = 1 To myOlSel.Count
If myOlSel.Item(x).Class = OlObjectClass.olMail Then
Set oMail = myOlSel.Item(x)
' Do Stuff
End If
Next x
End Sub
I am unable to get around the error message generated by Application.ActiveExplorer.
Any advice on how to convert this to VB.Net? I have searched high and low but all the examples I have found are VBA based.
This SO Question comes close but I can't make the leap between the languages.

After hard study, I managed to resolve this using the equivalent of:
Imports Microsoft.Office.Interop.Outlook
Sub GetSelectedItems()
Dim myOlApp As Outlook.Application = New Outlook.Application
Dim myOlExp As Outlook.Explorer = myOlApp.ActiveExplorer
Dim myOlSel As Outlook.Selection = myOlExp.Selection
Dim oMail As Outlook.MailItem
Dim x As Integer
For x = 1 To myOlSel.Count
If (TypeOf myOlSel.Item(x).Class is MailItem) Then
oMail = myOlSel.Item(x)
' Do Stuff
End If
Next x
End Sub

Related

Outlook 2016 VBA Type Mismatch on Application.GetNamespace (after Windows update)

I've had an Outlook 2016 VBA macro running for a year to check emails arriving in my inbox. Today, following installation of Windows 10 updates, I get a type mismatch error when this macro runs. The error line is the Set olNs = Application.GetNamespace("MAPI") line below:
Private Sub Application_Startup()
Dim olNs As Outlook.NameSpace
Dim Inbox As Outlook.MAPIFolder
Dim olRecip As Recipient
Dim dt As String
Dim strFile_Path As String
dt = Format(CStr(Now), "yyyy_mmm_dd_hh_mm")
strFile_Path = "d:\temp\parking.log"
Open strFile_Path For Append As #1
Write #1, dt & " " & "Application_Startup() triggered"
Close #1
Set olNs = Application.GetNamespace("MAPI")
Set olRecip = olNs.CreateRecipient("me#gmail.com")
Set Inbox = olNs.Folders("me#gmail.com").Folders("Inbox")
Set Items = Inbox.Items
End Sub
Any idea how I can fix this?
First of all, you need to make sure the COM references are set correctly.
You may try to run the code without setting a local variable:
Private Sub Application_Startup()
MsgBox "Welcome, " & Application.GetNamespace("MAPI").CurrentUser
Application.ActiveExplorer.WindowState = olMaximized
End Sub
I just ran into this issue (COM add-ins were fine) and as stated, removing the explicit declaration seems to fix the issue (you can also Dim the Namespace as an Object instead of Outlook.Namespace).
As a quick reference for anyone else I used the following code to bypass the issue:
With Application.GetNamespace("MAPI")
Dim Inbox As Outlook.MAPIFolder: Set Inbox = .GetDefaultFolder(olFolderInbox)
Dim Junk As Outlook.MAPIFolder: Set Junk = .GetDefaultFolder(olFolderJunk)
End With

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.

Unable to iterate over other person's appointments with VBA

I am trying to iterate over someone's outlook appointments with VBA. I believe the following fragment should do what I need, however, the line for each appm in cal.items pops up a little message box that says
Laufzeitfehler '-140492795 (f7a04405)':
Automatisierungsfehler
In english, that would probably be run time error .... automation error.
Why do I get this error?
option explicit
sub abcdef()
dim ol as outlook.application
dim ns as outlook.namespace
dim rcpt as outlook.recipient
dim cal as outlook.folder
dim appm as outlook.appointmentItem
set ol = new outlook.application
set ns = ol.GetNamespace("MAPI")
set rcpt = ns.createRecipient("Deere John")
rcpt.resolve
if not rcpt.resolved then
msgBox("Could not resolve recipient")
return
end if
set cal = ns.getSharedDefaultFolder(rcpt, olFolderCalendar)
if cal is nothing then
msgBox ("No Calender!")
return
end if
for each appm in cal.items
' Error occurs in previous line
next appm
end sub
Found some code here: http://www.slipstick.com/developer/copy-new-appointments-to-another-calendar-using-vba/ which would change how you dim appm... Instead of outlook.appointmentItem it has it simply as appointmentItem. So Dim appm as appoointmentItem
Edit: Their syntax also uses Set newCalFolder = GetFolderPath("display name in folder list\Calendar\Test") to define the cal variable, while you are using getSharedDefaultFolder
Even if you can manually add "Deere John" to your list of calendars, the calendar permission is probably not correct for VBA.
Try this to see if Outlook displays "Cannot display the folder. Microsoft Outlook cannot access the specified folder location."
Sub abcdef_CalDisplay()
Dim ol As Outlook.Application
Dim ns As Outlook.Namespace
Dim rcpt As Outlook.Recipient
Dim cal As Outlook.folder
Dim appm As Outlook.AppointmentItem
Set ol = New Outlook.Application
Set ns = ol.GetNamespace("MAPI")
Set rcpt = ns.CreateRecipient("Deere John")
rcpt.Resolve
If Not rcpt.Resolved Then
MsgBox ("Could not resolve recipient")
Return
Else ' <----
Set cal = ns.GetSharedDefaultFolder(rcpt, olFolderCalendar)
cal.Display ' <---
End If
End Sub

Vb.net Outlook Security Issue

hi am working on a project that uses outlook to do different things. one of which is accessing emails and using them. the code below is the code i am using to get the emails
Dim oApp As Outlook.Application = New Outlook.Application()
' Get Mapi NameSpace.
Dim oNS As Outlook.NameSpace = oApp.GetNamespace("mapi")
' Get Messages collection of Inbox.
Dim oInbox As Outlook.MAPIFolder =
oNS.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)
Dim oItems As Outlook.Items = oInbox.Items
oItems.Sort("[ReceivedTime]", True)
' oItems = oItems.Sort("date", False)
' Loop each unread message.
Dim oMsg As Outlook.MailItem
Dim i As Integer = 0
For Each item As Object In oItems
Try
If (TypeOf item Is Outlook.MailItem) Then
If i <= 100 Then
oMsg = item
Dim subject1 As String
Dim receivetime As String
Dim sender As String
Dim con As String
con = oMsg.Body
sender = oMsg.SenderName
subject1 = oMsg.Subject
receivetime = oMsg.ReceivedTime
End If
End If
Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
i = i + 1
Next
this code trips the outlook security ever time and i am looking for code that does not trip it and that doesn't involve editing the registry or turning down my outlook security settings. thank you for your time
See http://www.outlookcode.com/article.aspx?id=52 for the list of your options.
Essentially your options are Extended MAPI (C++ or Delphi), Redemption, or ClickYes.
I resolved this issue using the advice here:
http://www.slipstick.com/developer/change-programmatic-access-options/
He shows a step by step approach to enabling access to programs by running outlook as administrator. Although I am concerned about the security so wouldn't recommend it to anyone using a computer that isn't behind some significant protection.

I cannot see my VBA macro in 'run a script' selection box

I copied the following code in my oulook VBE, from one of the VBA communities and amended it as per my need.
I can run it using F5 and F8. Now I would like to run this macro whenever I receive an email in folder1.
I tried setting up a rule but I cannot see the macro listed in the 'run a script' selection box.
I have already checked that
macro security setting are correct
macro is in a module not in a class
can you please tell me what is going wrong in the setting.
Public Sub SaveAttachments()
Dim myOlapp As Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim myFolder As Outlook.MAPIFolder
Dim yourFolder As Outlook.MAPIFolder
Dim myItem As Outlook.MailItem
Dim myAttachment As Outlook.Attachment
Dim I As Long
Set myOlapp = CreateObject("Outlook.Application")
Set myNameSpace = myOlapp.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
Set yourFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myFolder = myFolder.Folders("folder1")
Set yourFolder = yourFolder.Folders("folder2")
For Each myItem In myFolder.Items
If myItem.Attachments.Count <> 0 Then
For Each myAttachment In myItem.Attachments
I = I + 1
myAttachment.SaveAsFile "C:\arthur\test.csv"
Next
End If
myItem.Move yourFolder
Next
End Sub
To be recognized as proper script macro for the Rule Wizard, the macro has to have the expected parameter:
Sub myRuleMacro(item as Outlook.MailItem)
MSDN article (still valid for Outlook 2007/2010/2013/2016)
Related article
Article about enabling run-a-script rules otherwise disabled due to security reasons
(registry key EnableUnsafeClientMailRules).
I had the same issue today on a similar script after Office was upgraded to Version 1803 (Build 9126.2282). Removing the "Pubic" keyword from the sub did the trick. Not sure why, since has been working the other way for years.
I also had to re-add the reg key that had disappeared - EnableUnsafeClientMailRules.