I just started using VBA and I am trying to launch the rules that I have thought python so I gave a try with the usual rule to short mails form someone and move that emails from inbox to another folder (in this case named zzz). Since I have three different accounts on outlook I want to do it for the account named myemail#company.com in the code.
Sub ResolveName()
Dim ns As NameSpace
Set ns = Application.Session
Dim acc As Account
Dim f As Folder
Dim myDestFolder As Folder
Dim myItem As Object
For Each acc In ns.Accounts
If acc = "myemail#company.com" Then
Set f = acc.DeliveryStore.GetDefaultFolder(olFolderInbox)
Set myDestFolder = f.Folders("zzz")
Set myItem = f.Items.Find("[SenderName] = 'SendersName Surname'")
While TypeName(myItem) <> "Nothing"
myItem.Move myDestFolder
Set myItem = myItems.FindNext
Wend
End If
Next
End Sub
When I run it, I get the following error
The following error has happened '-2147221233 (8004010f)' on execution time
No object found.
I have no idea what I am doing wrong
Thank you in advance.
Which line of code gives an error? Did you try to run the code under the debugger line-by-line?
Anyway, the following line of code is not correct:
If acc = "myemail#company.com" Then
The account object is not a string to compare. You need to use the Account.SmtpAddress property which returns a string representing the Simple Mail Transfer Protocol (SMTP) address for the Account.
However, I've found a similar issue which explains possible causes - the error number can tell us about a problem with a PST file (storage).
Related
I am trying to access the Folder from Outlook in VBA,some folder I am able to access but few folder are not. Although I am able to read 1 subfolder from the below code but when i am trying to change folder it is giving error.
This the code with which I am trying to access :
Public Sub ReadOutlookEmails()
Dim out_app As Outlook.Application
Dim get_name As Outlook.Namespace
Dim get_folder As Outlook.MAPIFolder
Dim oAccount As Object
Dim store_add As Object
Dim monthKeyValuePair As New Scripting.Dictionary
Dim email_list As New mscorlib.ArrayList
Dim date_List As New mscorlib.ArrayList
For Each c In Worksheets(ActiveSheet.Name).Range("D8:AH8")
date_List.Add c
'MsgBox c
Next c
Set out_app = New Outlook.Application
Set get_name = out_app.GetNamespace("MAPI")
For Each oAccount In out_app.Session.Accounts
If oAccount.SmtpAddress = "chhabranaveen#gmail.com" Then
Set store_add = oAccount.DeliveryStore
'MsgBox store_add.GetDefaultFolder(olFolderInbox).Folders("New Joinees")
'Set get_folder = store_add.GetDefaultFolder(olFolderInbox).Folders("On Bench Training")
Set get_folder = store_add.GetDefaultFolder(olFolderInbox)
Set get_folder = get_folder.Folders("On Bench Training")
Please help me here what I am doing wrong.
The error is MAPI_E_NOT_FOUND, which means the folder with the given name does not exist.
Make sure the folder named "On Bench Training" is really a subfolder of the Inbox.
Instead of getting the folder by its name you may try iterating over all subfolders and checking their name. So, basically instead of the following line:
Set get_folder = get_folder.Folders("On Bench Training")
You may iterate over all subfolder:
For Each uFolder In get_folder.Folders
If uFolder.Name = "On Bench Training" Then
MsgBox "Found!"
End If
Next uFolder
I have an Outlook 2019 IMAP account and I'm trying to use the following VBA code to mark all emails in the "Spam" folder as read automatically.
I found code here on Stack Overflow and changed first IF statement to get only the Spam folder.
It gives me
"Array index out of bounds"_ error (80020009)
after 3rd or 4th iteration (so up to three emails are being deleted) and the code breaks.
Why is it failing, and can I parameterize this code to choose an arbitrary folder name?
Sub MarkAllItemsAsRead()
Dim objStores As Outlook.Stores
Dim objStore As Outlook.Store
Dim objOutlookFile As Outlook.Folder
Dim objFolder As Outlook.Folder
'Process all Outlook files
Set objStores = Outlook.Application.Session.Stores
For Each objStore In objStores
Set objOutlookFile = objStore.GetRootFolder
For Each objFolder In objOutlookFile.Folders
'Process mail folders
If objFolder.DefaultItemType = olMailItem And objFolder.Name = "Spam" Then
Debug.Print objFolder.Name
Call ProcessFolders(objFolder)
End If
Next
Next
End Sub
Sub ProcessFolders(ByVal objCurFolder As Outlook.Folder)
Dim objUnreadItems As Outlook.Items
Dim i As Integer
Dim objItem As Object
Dim objSubFolder As Outlook.Folder
Set objUnreadItems = objCurFolder.Items.Restrict("[Unread]=True")
'Mark all unread emails as read
For i = 1 To objUnreadItems.Count
Set objItem = objUnreadItems.Item(i)
objItem.UnRead = False
objItem.Save
Next
End Sub
Simply reversing the order of iteration will likely fix your problem.
What's (probably) happening here is that when you change the messages, the server wants to be extra helpful, and moves them messages elsewhere, and once that is done, what was "message number 2" is now "message number 1". Processing them starting with the highest number ought to solve it, because if the highest-numbered message goes away, no other messages are renumbered.
IMAP offers better ways to solve it (either setting all read with one command, or specifying them by UID instead of by sequence number), but reversing the order of iteration is a small change and probably will work.
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
When using the Move method on an AppointmentItem in an Outlook macro, I lose the ability to receive updates because it is creating a copy of the item instead of truly moving it. This behavior causes the item to no longer be linked with the original and will not retain item updates as a result.
I want to replicate through VBA the cut/paste behavior you get which is able to maintain the original object and does not cause updates to be lost.
I believe this has something to do with the GlobalAppointmentID based on searching around, however I have not been able to find a way to actually move the appointment.
The code I'm using is below. GetFolderFromPath is a helper function to just return a folder object from the path, which works perfectly well.
Sub MoveItem()
Dim targetPath As String: targetPath = "\\tnolan#microsoft.com\Calendar\OOFS"
If Application.ActiveExplorer.Selection.Count = 0 Then
MsgBox ("No item selected")
Exit Sub
Else
Dim targetFolder As Outlook.Folder
Set targetFolder = GetFolderFromPath(targetPath)
For x = 1 To Application.ActiveExplorer.Selection.Count
Dim oSelected As Variant
Set oSelected = Application.ActiveExplorer.Selection.Item(x)
If oSelected.Class = olAppointment Then
Dim NS As NameSpace: Set NS = Application.GetNamespace("MAPI")
Dim oAppt As AppointmentItem: Set oAppt = NS.GetItemFromID(oSelected.EntryID)
oAppt.Move targetFolder
Set oAppt = Nothing
Set NS = Nothing
End If
Set oSelected = Nothing
Next x
Set targetFolder = Nothing
End If
End Sub
Outlook processes incoming meeting updates/deletions only against the default Calendar folder. If you move an appointment to a different folder, meeting update in your Inbox will create a new appointment in the default Calendar folder.
After playing around with my code for a little bit, I've found that this code works for me in a similar situation:
oAppt.CopyTo(targetFolder, olCopyAsAccept)
oAppt.Delete
I have a feeling that for some reason the AppointmentItem.Move command passes as olCreateAppointment which would always create a new GlobalAppointmentID.
However, this still has a side-effect of responding accept to the Appointment.
Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 4 years ago.
Improve this question
I have written a message handler function in Outlook's Visual Basic (we're using Outlook 2003 and Exchange Server) to help me sort out incoming email.
It is working for me, except sometimes the rule fails and Outlook deactivates it.
Then I turn the rule back on and manually run it on my Inbox to catch up. The rule spontaneously fails and deactivates several times a day.
I would love to fix this once and for all.
This code showed me the different TypeNames that were in my Inbox:
Public Sub GetTypeNamesInbox()
Dim myOlItems As Outlook.Items
Set myOlItems = application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items
Dim msg As Object
For Each msg In myOlItems
Debug.Print TypeName(msg)
'emails are typename MailItem
'Meeting responses are typename MeetingItem
'Delivery receipts are typename ReportItem
Next msg
End Sub
HTH
I use the following VBA code snippet in other Office Applications, where the Outlook Library is directly referenced.
' Outlook Variables
Dim objOutlook As Outlook.Application: Set objOutlook = New Outlook.Application
Dim objNameSpace As Outlook.NameSpace: Set objNameSpace = objOutlook.GetNamespace("MAPI")
Dim objFolder As MAPIFolder: Set objFolder = objNameSpace.PickFolder()
Dim objMailItem As Outlook.MailItem
Dim iCounter As Integer: iCounter = objFolder.Items.Count
Dim i As Integer
For i = iCounter To 1 Step -1
If TypeOf objFolder.Items(i) Is MailItem Then
Set objMailItem = objFolder.Items(i)
With objMailItem
etc.
have written a message handler function in Outlook's Visual Basic (we're using Outlook 2003 and Exchange Server) to help me sort out incoming email. It is working for me, except sometimes the rule fails and Outlook deactivates it. Then I turn the rule back on and manually run it on my Inbox to catch up. The rule spontaneously fails and deactivates several times a day. I would love to fix this once and for all.
Here is the code stripped of the functionality, but giving you an idea of how it looks:
Public WithEvents myOlItems As Outlook.Items
Public Sub Application_Startup()
' Reference the items in the Inbox. Because myOlItems is declared
' "WithEvents" the ItemAdd event will fire below.
' Set myOlItems = Outlook.Session.GetDefaultFolder(olFolderInbox).Items
Set myOlItems = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub myOlItems_ItemAdd(ByVal Item As Object)
On Error Resume Next
If TypeName(Item) = "MailItem" Then
MyMessageHandler Item
End If
End Sub
Public Sub MyMessageHandler(ByRef Item As MailItem)
Dim strSender As String
Dim strSubject As String
If TypeName(Item) <> "MailItem" Then
Exit Sub
End If
strSender = LCase(Item.SenderEmailAddress)
strSubject = Item.Subject
rem do stuff
rem do stuff
rem do stuff
End Sub
One error I get is "Type Mismatch" calling MyMessageHandler where VB complains that Item is not a MailItem. Okay, but TypeName(Item) returns "MailItem", so how come Item is not a MailItem?
Another one I get is where an email with an empty subject comes along. The line
strSubject = Item.Subject
gives me an error. I know Item.Subject should be blank, but why is that an error?
Thanks.
My memory is somewhat cloudy on this, but I believe that a MailItem is not a MailItem when it is something like a read receipt. (Unfortunately, the VBA code that demonstrated this was written at another job and isn't around now.)
I also had code written to process incoming messages, probably for the same reason you did (too many rules for Exchange, or rules too complex for the Rules Wizard), and seem to recall running into the same problem you have, that some items seemed to be from a different type even though I was catching them with something like what you wrote.
I'll see if I can produce a specific example if it will help.
There are many types of items that can be seen in the default Inbox.
In the called procedure, assign the incoming item to an Object type variable. Then use TypeOf or TypeName to determine if it is a MailItem. Only then should your code perform actions that apply to emails.
i.e.
Dim obj As Object
If TypeName(obj) = "MailItem" Then
' your code for mail items here
End If
Dim objInboxFolder As MAPIFolder
Dim oItem As MailItem
Set objInboxFolder = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
For Each Item In objInboxFolder.Items
If TypeName(Item) = "MailItem" Then
Set oItem = Item
next
why not use a simple error handler for the code? Seriously. You could write an error for each read of a property or object that seems to fail. Then have it Resume no matter what. No need for complex error handling. Think of a test that shows an empty subject. Since you don't know what value it will return, if any, and it seems to error on an empty or blank subject, you need to picture it as a simple test with a possible error. Run the test as an if statement (one in which you will get an error anyway), and have the program resume on error.
On Error Resume Next
If object.subject = Null 'produces an error when subject is null, otherwise allows a good read
strSubject = "" 'sets the subject grab string to a null or empty string as a string
Else
strSubject = object.subject 'Sets the subject grab string to the subject of the message\item
End If