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.
Related
I have the below code to permanently delete mail from the inbox.
However, when responses to a meeting invite, to say the person has accepted the meeting do not delete.
When I click on that mail and run this code it does not delete?
Sub PermDelete(Item As Outlook.MailItem)
' First set a property to find it again later
Item.UserProperties.Add "Deleted", olText
Item.Save
Item.Delete
'Now go through the deleted folder, search for the property and delete item
Dim objDeletedFolder As Outlook.Folder
Dim objItem As Object
Dim objProperty As Variant
Set objDeletedFolder = Application.GetNamespace("MAPI"). _
GetDefaultFolder(olFolderDeletedItems)
For Each objItem In objDeletedFolder.items
Set objProperty = objItem.UserProperties.Find("Deleted")
If TypeName(objProperty) <> "Nothing" Then
objItem.Delete
End If
Next
End Sub
To run code that has an argument like (Item As Outlook.MailItem) you need to pass the information in this case Item.
You cannot run such code from a button.
You can run Sub delItemPermanently() from a button or F8 to step through.
Option Explicit
Sub delItemPermanently()
' Select a single item
' This line passes the item to PermDelete
PermDelete ActiveExplorer.Selection(1)
End Sub
Sub PermDelete(Item As Object)
' Notice Object not Mailitem
' This will accommodate mailitems as well
...
End Sub
In the code your function accepts an instance of the MailItem class only. But an Outlook folder may contain different types of items - appointments, documents, notes and etc. To differentiate them at runtime you can use the following construction:
Dim obj As Object
If TypeName(obj) = "MailItem" Then
' your code for mail items here
End If
So, you need to declare the function in the following way (if you don't need to do separate actions for different kind of items):
Sub PermDelete(Item As Object)
' First set a property to find it again later
Item.UserProperties.Add "Deleted", olText
Item.Save
Item.Delete
'Now go through the deleted folder, search for the property and delete item
Dim objDeletedFolder As Outlook.Folder
Dim objItem As Object
Dim objProperty As Variant
Set objDeletedFolder = Application.GetNamespace("MAPI"). _
GetDefaultFolder(olFolderDeletedItems)
For Each objItem In objDeletedFolder.items
Set objProperty = objItem.UserProperties.Find("Deleted")
If TypeName(objProperty) <> "Nothing" Then
objItem.Delete
End If
Next
End Sub
Set Item to a generic Object
Example on selected item
Option Explicit
Public Sub Example()
Dim obj As Object
Set obj = ActiveExplorer.Selection.Item(1)
obj.Delete
End Sub
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.
can someone advise what have I done wrong on here? It is not picking up the emails the way it should (i.e. automatically download the attachments into a folder). There is no error messages, but simply no action (I went F8 but would not notice any irregularities).
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
On Error GoTo ErrorHandler
'Only act if it's a MailItem
Dim Msg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Set Msg = item
'Change variables to match need. Comment or delete any part unnecessary.
If (Msg.SenderName = "test123#gmail.com") And _
(Msg.Subject = "Test123") And _
(Msg.Attachments.Count >= 1) Then
'Set folder to save in.
Dim olDestFldr As Outlook.MAPIFolder
Dim myAttachments As Outlook.Attachments
Dim Att As String
'location to save in. Can be root drive or mapped network drive.
Const attPath As String = "C:\Test\Test1\"
' save attachment
Set myAttachments = item.Attachments
Att = myAttachments.item(1).DisplayName
myAttachments.item(1).SaveAsFile attPath & Att
Msg.UnRead = False
End If
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
Also, when I'm trying to F8 for errors, the VBA only goes through the first part of the code i.e. Private Sub Application_Startup(), I'm unable to test the other part {Private Sub Items_ItemAdd(ByVal item As Object)} cos the VBA simply denies going through it line by line (no error pop-ups or anything, it simply is not picking up the lines)
The problem is in the line
myAttachments.item(1).SaveAsFile attPath & Att
You are always picking attachment no 1, which might be something else than you think. Add a For Each around this, and you'll hopefully get some better results.
My guess is that your problem is this condition:
If (Msg.SenderName = "test123#gmail.com")
The MailItem.SenderName property returns the display name of the sender, which may not be the actual email address. You should be checking the MailItem.SenderEmailAddress property instead.
If the email you're trying to match is an Exchange address (ie, it's from someone in your office's Outlook account), the MailItem.SenderEmailAddress will return an incomprehensible string that you'll need to resolve to an actual email. In that case, you'd need to check the MailItem.Sender.GetExchangeUser().PrimarySmtpAddress property instead.
For that reason, I like to use an "emailMatches" function that checks both scenarios. Then your condition would be something like:
If emailMatches(Msg, "test123#company.com")
Here's the function I use:
Function emailMatches(mItem As Object, addressToMatch As String) As Boolean
Dim goAhead As Boolean
goAhead = False
If UCase(mItem.SenderEmailAddress) = UCase(addressToMatch) Then
goAhead = True
ElseIf Left(mItem.SenderEmailAddress, 5) = "/O=EX" Then
If UCase(mItem.Sender.GetExchangeUser().PrimarySmtpAddress) = UCase(addressToMatch) Then
goAhead = True
End If
End If
emailMatches = goAhead
End Function
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.
I managed to find a nice little script that will forward emails to an external address becuase our exchange server is configured not to do that.
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim varEntryIDs
Dim objItem
Dim i As Integer
varEntryIDs = Split(EntryIDCollection, ",")
For i = 0 To UBound(varEntryIDs)
Set objItem = Application.Session.GetItemFromID(varEntryIDs(i))
Set myItem = objItem.Forward
myItem.Recipients.Add "mike.dumka#outlook.com"
myItem.Send
Next
End Sub
Works perfect. But now ... I would only like to do this if they are messages, not appointment updates or requests. I have no idea where to find this, or even what to look for. My VBA skills are from very long ago.
If you look at the screenshot, I think I have the MsgBox function in the right way, but could you verify?
Thanks,
Mike
You can either check the myItem.MessageClass property (it will be "IPM.Note" for the regular messages) or myItem.Class property - it will be 43 (olMail).
Just a little bit of conditional logic to ensure that you're only dealing with MailItem (since objItem is variant/object and may be another type of item like an AppointmentItem, etc.):
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
MsgBox "I'm working!", vbExclamation
Dim varEntryIDs
Dim objItem As Object
Dim myItem As MailItem
Dim i As Integer
varEntryIDs = Split(EntryIDCollection, ",")
For i = 0 To UBound(varEntryIDs)
Set objItem = Application.Session.GetItemFromID(varEntryIDs(i))
'## Check the item's TypeName and ONLY process if it's a MailItem:
If TypeName(objItem) = "MailItem" Then
Set myItem = objItem.Forward
myItem.Recipients.Add "mike.dumka#outlook.com"
myItem.Send
Else:
MsgBox "Type of item is: " & TypeName(objItem)
End If
Next
End Sub