Runtime error '13' type mismatch - vba

I created a macro to download attachments form the outlook whenever we receive a new mail, but I am getting error as "Run time Error '13' Type mismatch " and below is the code am using.
Can anyone please help me in resolving this.
Option Explicit
Private Sub Application_NewMail()
Dim onamespace As Outlook.NameSpace
Set onamespace = Outlook.GetNamespace("MAPI")
Dim myfol As Outlook.Folder
Set myfol = onamespace.GetDefaultFolder(olFolderInbox)
Dim omail As Outlook.MailItem
Set omail = Outlook.CreateItem(olMailItem)
Dim Atmt As Outlook.Attachment
For Each omail In myfol.Items
If omail.SenderEmailAddress = "sacchu693#gmail.com" Then
For Each Atmt In omail.Attachments
Atmt.SaveAsFile "Z:\True_ID\46 RSA\" & Atmt.FileName
Next
Else
End If
Next
End Sub

Your code does not make much sense - you are creating a new message (oMail), but you never do anything with it. You just use the variable declaration to loop over all items in the Inbox. Since it is declared as MailItem, it blows up when it encounters an item of a type other than MailItem (such as ReportItem or MeetingItem).
Use NewMailEx event instead - it passes the new message's entry id as the parameter. Use it to call Namespace.GetItemFromID.

Related

Reading mail RTFbody fails with error 'not implemented'

I have code that reads mail to generate a task with the mail's content.
In a few cases this hits a problem, when reading the RTFbody from the mail, saying "not implemented".
Can I test against this? Like WHEN IS NULL ... which checks if a variable has appropriate content.
Sub CreateTempTaskFromMail()
Dim oMail As Outlook.MailItem
Set oMail = ActiveInspector.CurrentItem
Dim s, sNr As String
s = oMail.subject
Dim oTask As Outlook.TaskItem
Set oTask = CreateTaskWithTempFolder(s, False) ' Function creating and returing task
oTask.RTFBody = oMail.RTFBody
End sub
I tried to test several ways if RTFbody has a problem. All of these approaches throw an error.
If oMail.RTFBody Is Nothing Then Stop
If IsError(oMail.RTFBody) Then Stop
If IsMissing(oMail.RTFBody) Then Stop
If IsEmpty(oMail.RTFBody) Then Stop
If there is absolutely no real solution then
Option Explicit
Sub CreateTempTaskFromMail()
Dim oObj As Object
Dim oMail As mailItem
Dim oTask As TaskItem
Dim s As String
Set oObj = ActiveInspector.currentItem
If oObj.Class = olMail Then
Set oMail = oObj
s = oMail.subject
Set oTask = CreateTaskWithTempFolder(s, False) ' Function creating and returing task
' If you absolutely cannot determine the problem
' https://excelmacromastery.com/vba-error-handling#On_Error_Resume_Next
On Error Resume Next
oTask.RTFBody = oMail.RTFBody
If Err <> 0 Then
Debug.Print "Error was bypassed using a technique that is to be avoided."
Exit Sub
End If
' Consider mandatory AND as soon as possible
On Error GoTo 0
oTask.Display
Else
Debug.Print "not a mailitem"
End If
End Sub
Before accessing the RTFBody property in the code I'd suggest checking the item's type first to make sure such property exists for a specific item type:
If TypeOf item Is MailItem Then
' do whatever you need with RTFBody here
End If
Or
If TypeName(item) = "MailItem" Then
' do whatever you need with RTFBody here
End If
If you are using Office 2016 product, you should update office. It is early office 2016 build's bug.

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

Move mails to folders with the sender's name

It is possible to create a rule which, for a sender, moves all the mails to the folder of your choice (for example, it creates a folder with the name of the sender).
If I want that for all the expeditors, I need to repeat the rule creation for each sender.
What I'd wish would be a macro "meta-rule" for each sender to have a folder with their name with the corresponding mails sorted.
I tried to start from the topic Outlook template rule to sort mails among directories.
I wrote this:
Sub RulesForFolders(m As MailItem)
Dim fldr As Outlook.Folder
For Each fldr In GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders
if fldr.Name Like m.SenderName Then m.MoveTo(SenderName)
else folders.add(m.SenderName)
Next
Set fldr = Nothing
End Sub
Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
'
' If desperate declare as variant
Private Sub RulesForFolders(m As mailItem)
Dim targetFldr As folder
Dim myRoot As folder
Dim i As Long
Set myRoot = Session.GetDefaultFolder(olFolderInbox)
Debug.Print m.senderName
' This is often misused.
On Error Resume Next
' If folder exists the error is bypassed
' This is a rare beneficial use of On Error Resume Next
myRoot.folders.Add m.senderName
' Consider it mandatory to return to normal error handling
On Error GoTo 0
Set targetFldr = myRoot.folders(m.senderName)
m.Move targetFldr
End Sub
Private Sub RulesForFolders_test()
' Code requiring a parameter cannot run independently
Dim selItem As Object
' first select a mailitem
Set selItem = ActiveExplorer.Selection(1)
If selItem.Class = olMail Then
RulesForFolders ActiveExplorer.Selection(1)
End If
End Sub
First of all, I'd suggest starting from the NewMailEx event of the Application class which is fired when a new item is received in the Inbox. This event fires once for every received item that is processed by Microsoft Outlook. The item can be one of several different item types, for example, MailItem, MeetingItem, or SharingItem. The EntryIDsCollection string contains the Entry ID that corresponds to that item. The NewMailEx event fires when a new message arrives in the Inbox and before client rule processing occurs. You can use the Entry ID returned in the EntryIDCollection array to call the NameSpace.GetItemFromID method and process the item.
To find the folder with a sender name you can iterate over all subfolders recursively:
Private Sub processFolder(ByVal oParent As Outlook.MAPIFolder)
Dim oFolder As Outlook.MAPIFolder
Dim oMail As Outlook.MailItem
For Each oMail In oParent.Items
'Get your data here ...
Next
If (oParent.Folders.Count > 0) Then
For Each oFolder In oParent.Folders
processFolder oFolder
Next
End If
End Sub
Finally, I'd recommend delving deeper with VBA by starting from the Getting started with VBA in Office article.
You can also use the following code if you don't need to iterate over all folders:
Sub RulesForFolders(m As MailItem)
Dim fldr As Outlook.Folder
Dim new_fldr As Outlook.Folder
Dim ns as Outlook.Namespace
Dim inbox as Outlook.Folder
Set ns = Application.GetNamespace("MAPI")
Set inbox = ns.GetDefaultFolder(olFolderInbox)
For Each fldr In inbox.Folders
if InStr(fldr.Name,m.SenderName) > 0 Then
m.MoveTo(fldr)
Return
End If
Next
Set new_fldr = folders.add(m.SenderName)
m.MoveTo(new_fldr)
Set fldr = Nothing
Set new_fldr = Nothing
Set inbox = Nothing
Set ns = Nothing
End Sub

VBA code to attach files - No appropriate permission to perform this operation

I'm trying to attach a file to all the mails in my Outbox folder using Outlook. I ran the following code:
Public Sub ABT()
Dim olNs As Outlook.NameSpace
Dim olOutbox As Outlook.MAPIFolder
Dim olItem As Object
Dim olEmail As Outlook.MailItem
Set olNs = GetNamespace("MAPI")
Set olOutbox = olNs.GetDefaultFolder(olFolderOutbox)
For Each olItem In olOutbox.Items
If olItem.Class = olMail Then
Set olEmail = olItem
With olEmail
.Attachments.Add "C:\Users\Augustin\Pictures\znakovi\blah.jpg"
.Save
.Send
End With
End If
Next
End Sub
But when I run the code, it tells me that I don't have the appropriate permissions to perform this operation.
I started Outlook in Administrator mode, so I think this error shouldn't happen and I would be very thankful if someone could point me to the solution.
Messages in the Outbox folder are being submitted, they cannot be touched - they are owned by the spooler.
If yo want to process outgoing messages, trap the Application.ItemSend event and modify the message there.

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.