I want to delete a mail when the delivered response comes. This is a fragment of my code. I don't understand why the for each runs into error 13
Sub test222()
Dim oapp As Outlook.Application
Dim osession As Outlook.NameSpace
Dim oInbox As Outlook.MAPIFolder
Dim oSentItem As Outlook.MAPIFolder
Dim omail As Outlook.MailItem
Dim conID As String
Set oapp = New Outlook.Application
Set osession = oapp.GetNamespace("MAPI")
Set oInbox = osession.GetDefaultFolder(olFolderInbox)
Set oSentItem = osession.GetDefaultFolder(olFolderSentMail)
i = 1
For Each omail In oSentItem.Items
If (omail.Subject = "Delivered: aa") Then
Msgbox "Hi"
omail.Delete
Exit For
Else
i = i + 1
End If
Next
End Sub
Declare omail as Object and check TypeName in the loop. The way you did it, there will be a type mismatch error when the loop runs into something else than an e-mail message, e.g. an appointment item.
Also read about late binding. I'd advise to use this functionality when you are working with non-default libraries.
Related
I am trying to create a tool that both acts on new emails while Outlook is open as well as on emails received while the Outlook application is closed.
This is what I have so far:
-One sub that creates a note item upon quitting the app.
-One sub that filters emails in the inbox by the their received time.
The second sub is working when I debug (but also infinitely loops and reprocesses the new emails over and over), but does not work (as in does not take any action on the new emails) when I launch the application, expecting the startup event to trigger the sub.
Microsoft Outlook Objects/"ThisOutlookSession"):
Option Explicit
Private StartupTrigger As SaveAttachment1
Private ShutdownTrigger As Class2
Private Sub Application_Startup()
Set StartupTrigger = New SaveAttachment1
StartupTrigger.SaveAttachment1_Initialize
StartupTrigger.Process_New_Items
End Sub
Private Sub Application_Quit()
Set ShutdownTrigger = New Class2
ShutdownTrigger.ExitApp
End Sub
Class Modules:
Class2
Public Sub ExitApp()
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olNoteIt As Outlook.NoteItem
Dim myFol As Outlook.Folder
Dim myFilter As String
Dim i As Object
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set myFol = olNS.GetDefaultFolder(olFolderNotes) '.Folders("Attachment Filters")
myFilter = "[Subject] = 'App Close Time'"
For Each i In myFol.Items.Restrict(myFilter)
i.Delete
Next i
Set olNoteIt = olApp.CreateItem(olNoteItem)
With olNoteIt
.Body = "App Close Time"
'.Move myFol
End With
olNoteIt.Save
End Sub
SaveAttachment1
Option Explicit
Public WithEvents olItems As Outlook.Items
Public Sub SaveAttachment1_Initialize()
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olItems = olNS.GetDefaultFolder(olFolderInbox).Folders("User ID (DMs) - Wells Fargo").Items
End Sub
Public Sub Process_New_Items()
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim filterString As String
Dim olFol As Outlook.Folder
Dim i As Object
Dim olmi As Outlook.MailItem
Dim cfilter As Object
Dim my_olMail As MailItem
Dim dmi As MailItem
Dim utcdate As Date
Dim filterfolder As Outlook.Folder
Dim SMTPAddress As String
Dim olAtt As Outlook.Attachment
Dim fso As Object
Dim olAttFilter As String
Dim timeFol As Outlook.Folder
Dim lastclose As String
Dim timeFilter As String
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set filterfolder = olNS.GetDefaultFolder(olFolderContacts).Folders("FilterContacts")
Set dmi = olApp.CreateItem(olMailItem)
Set timeFol = olNS.GetDefaultFolder(olFolderNotes)
timeFilter = "[Subject] = 'App Close Time'"
For Each i In timeFol.Items.Restrict(timeFilter)
lastclose = i.CreationTime
Next i
utcdate = dmi.PropertyAccessor.LocalTimeToUTC(lastclose)
filterString = "#SQL=""urn:schemas:httpmail:datereceived"" >= '" & Format(utcdate, "dd mmm yyyy hh:mm") & "'"
Set fso = CreateObject("Scripting.FileSystemObject")
Set olFol = olNS.GetDefaultFolder(olFolderInbox)
For Each i In olFol.Items.Restrict(filterString)
If TypeName(i) = "MailItem" Then
If i.SenderEmailType = "EX" Then
SMTPAddress = i.Sender.GetExchangeUser.PrimarySmtpAddress
Else
SMTPAddress = i.SenderEmailAddress
End If
For Each cfilter In filterfolder.Items
If SMTPAddress = cfilter.JobTitle Then
If InStr(1, LCase(i.Subject), cfilter.BusinessTelephoneNumber) <> 0 Then
For Each olAtt In i.Attachments
If InStr(1, LCase(olAtt.FileName), cfilter.HomeTelephoneNumber) <> 0 Then
olAttFilter = fso.GetExtensionName(olAtt.FileName)
Select Case olAttFilter
Case cfilter.BusinessFaxNumber
olAtt.SaveAsFile cfilter.MobileTelephoneNumber & "\" & olAtt.FileName
Case Else
End Select
Else: End If
Next olAtt
Else: End If
Else: End If
Next cfilter
End If
Next i
End Sub
The "Process_New_Items()" sub is admittedly a mess, but essentially, it is referencing an Outlook contact item and uses the different fields of the contact item to filter the new emails, and then save the attachment if the email meets all the filter criteria.
Thanks!
Adam
acts on new emails while Outlook is open as well as on emails received while the Outlook application is closed
First, to handle new emails I'd recommend using the Application.NewMailEx event which is fired when a new message arrives in the Inbox and before client rule processing occurs. Use the Entry ID represented by the EntryIDCollection argument to call the NameSpace.GetItemFromID method and process the item. 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.
Another possible alternative is to using ItemAdd event on the Inbox folder.
You may find the following series of articles helpful:
Outlook NewMail event unleashed: the challenge (NewMail, NewMailEx, ItemAdd)
Outlook NewMail event: solution options
Outlook NewMail event and Extended MAPI: C# example
Outlook NewMail unleashed: writing a working solution (C# example)
Second, when Outlook is closed the OOM is useless.
I've tried countless ways of deleting items from a custom folder called "Spam Digests" older than 14 days. I have successfully done this when I nest this folder underneath the olDefaultFolder(Inbox) but when I have it outside of the default inbox, I cannot reference it as I receive object not found.
Here is what I have and I cannot seem to figure out why the object is not found when referencing "fldSpamDigest"
Dim outapp As Outlook.Application
Set outapp = CreateObject("outlook.application")
Dim olitem As Object
Dim fldSpamDigest As Outlook.MAPIFolder
Set fldSpamDigest = outapp.GetNamespace("MAPI").Folders("Spam Digests")
For Each olitem In fldSpamDigest.Items
If DateDiff("d", olitem.CreationTime, Now) > 14 Then olitem.Delete
Next
Set fldSpamDigest = Nothing
Set olitem = Nothing
Set outapp = Nothing
GetDefaultFolder(olFolderInbox) is a shortcut.
You can reference any folder the long way.
Sub reference_walk_the_path()
Dim outapp As Outlook.Application
Set outapp = CreateObject("outlook.application")
Dim olitem As Object
Dim fldSpamDigest As Outlook.MAPIFolder
' from the default inbox to the parent which is your mailbox
Set fldSpamDigest = outapp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Parent
' from the mailbox to a folder at the same level as the Inbox
Set fldSpamDigest = fldSpamDigest.folders("Spam Digests")
' or
' directly from the mailbox to a folder at the same level as the Inbox
'Set fldSpamDigest = outapp.GetNamespace("MAPI").folders("your email address").folders("Spam Digests")
For Each olitem In fldSpamDigest.Items
If dateDiff("d", olitem.CreationTime, Now) > 14 Then olitem.Delete
Next
Set fldSpamDigest = Nothing
Set olitem = Nothing
Set outapp = Nothing
End Sub
Dim outapp As Outlook.Application
Set outapp = CreateObject("outlook.application")
There is no need to create a new Outlook Application instance in the Outlook VBA, simply use the Application property
To reference a folder that is not under default Inbox - example would be
Option Explicit
Public Sub Example()
Dim olNs As Outlook.NameSpace
Set olNs = Application.Session
Dim Digest_Fldr As Outlook.MAPIFolder
Set Digest_Fldr = olNs.GetDefaultFolder(olFolderInbox) _
.Parent.Folders("fldSpamDigest")
Dim Items As Outlook.Items
Set Items = Digest_Fldr.Items
Dim i As Long
For i = Items.Count To 1 Step -1
DoEvents
Debug.Print Items(i).Subject
Next
End Sub
Summary
I'm trying to add hyperlinks to tasks created from emails that I have moved to another folder.
The goal is to have the task contain a hyperlink to the Outlook item that was moved to a "Processed Email" folder".
Problem
I don't understand how to move a MailItem and then get its new EntryID after it moves.
The "naive" way doesn't work. After using the Move method to move a MailItem object, the EntryID property does not reflect a change in ID.
Details
Creating a hyperlink to an Outlook item using the format outlook:<EntryID> is easy enough if the Outlook item remains in the Inbox, since I can just get the EntryID of the object that I am linking to. However, Outlook changes the EntryID when an object is moved.
I want to understand how to get the updated ID so that I can construct an accurate link.
Example
The message boxes show the EntryID property of objMail returns the same value despite the fact that the object has moved. However, running a separate macro on the mail in the destination folder confirms that the EntryID has changed with the move.
Sub MoveObject(objItem As Object)
Select Case objItem.Class
Case olMail
Dim objMail As MailItem
Set objMail = objItem
MsgBox (objMail.EntryID)
Dim inBox As Outlook.MAPIFolder
Set inBox = Application.ActiveExplorer().Session.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)
Dim destFolder As Outlook.MAPIFolder
Set destFolder = inBox.Folders("Processed Email")
If (Application.ActiveExplorer().CurrentFolder.Name <> destFolder.Name) Then
objMail.Move destFolder
End If
MsgBox (objMail.EntryID)
End Select
End Sub
The Move method of the MailItem class returns an object that represents the item which has been moved to the designated folder. You need to check out the EntryID value of the returned object, not the source one.
Anyway, you may consider handling the ItemAdd event of the target folder to make sure that an updated entry ID value is used all the time.
Sub MoveItems()
Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.Folder
Dim myDestFolder As Outlook.Folder
Dim myItems As Outlook.Items
Dim myItem As Object
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myItems = myInbox.Items
Set myDestFolder = myInbox.Folders("Personal Mail")
Set myItem = myItems.Find("[SenderName] = 'Eugene Astafiev'")
While TypeName(myItem) <> "Nothing"
myItem.Move myDestFolder
Set myItem = myItems.FindNext
Wend
End Sub
Hello can you please elaborate your answer I am not able to understand it.
Anyway, you may consider handling the ItemAdd event of the target folder to make sure that an updated entry ID value is used all the time.
Here is my code and I need EntryID after moving.
Sub Movetest1()
Dim olApp As Outlook.Application
Dim olns As Outlook.NameSpace
Dim Fld As Folder
Dim ofSubO As Outlook.MAPIFolder
Dim myDestFolder As Outlook.Folder
Dim ofolders As Outlook.Folders
Dim objItems As Outlook.Items
Dim myRestrictItems As Outlook.Items
Dim i As Long
Dim myitem As Object
' Dim MailItem As Microsoft.Office.Interop.Outlook.MailItem
Dim MailItem, moveditem As Outlook.MailItem
Dim eid As String
Dim sid As Variant
Dim newEID As String
'---------------------------------------------------------------------------------------------------------
Set olApp = New Outlook.Application
Set olns = olApp.GetNamespace("MAPI")
For Each Fld In olns.Folders
If Fld.Name = "GSS Payables" Then
'
' MsgBox Fld.Name
' Debug.Print " - "; Fld.EntryID
Set Fld = olns.GetFolderFromID("000000009DA6D76FBE7A58489450CDF6094F592A0100A2457DC435B22448A832DB721D8185B1000000B6207D0000").Folders("Inbox")
Exit For
End If
Next
Set objItems = Fld.Items
eid = "000000009DA6D76FBE7A58489450CDF6094F592A0700A2457DC435B22448A832DB721D8185B1000000B620800000A2457DC435B22448A832DB721D8185B100007FF773270000"
sid = "000000009DA6D76FBE7A58489450CDF6094F592A0100A2457DC435B22448A832DB721D8185B1000000B6207D0000"
Set myDestFolder = Fld.Folders("Bhagyashri")
'Set myitem = objItems.Find("[SenderName]='Microsoft Outlook '")
Set MailItem = olns.GetItemFromID(eid)
Set moveditem = MailItem.Move(myDestFolder)
"giving error here
newID = moveditem.entryid
Debug.Print "newID -"; newID
' get mailitem.parent.storeid
MsgBox "done"
End
Use the following syntax:
Dim MoveToFolder As outlook.MAPIFolder
Dim MyItem As outlook.MailItem
Dim NewEntryID As String
NewEntryID = MyItem.Move(MoveToFolder).ENTRYID
After MyItem.Move is executed the new ENTRYID will be returned to the NewEntryID variable.
Is it possible to run a macro on an email that I manually select in my inbox. For instance, right click on the email and select "Send to >> Macro >> (show list of subroutines accepting Outlook.MailItem as a parameter)?
I think you will have to add a Button to the mail-ribbon. This Button can call an Routine.
In this Routine you use the active selection:
Sub example()
Dim myOlApp As Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Dim olExplorer As Explorer
Dim olfolder As MAPIFolder
Dim olSelection As Selection
Dim olitem As mailitem
Set olExplorer = Application.ActiveExplorer
Set olfolder = Application.ActiveExplorer.CurrentFolder
If olfolder.DefaultItemType = olMailItem Then
Set olSelection = olExplorer.Selection
end if
For Each olitem In olSelection
'do something
Next olitem
end sub
I hope you get this working...
Max
So, I was able to simplify Max's answer a bit, but he certainly pointed me in the right direction. Below is basically what I'm going with. After selecting an email in my inbox, I should be able to run this macro and proceed to work on it.
Sub example()
Dim x, mailItem As Outlook.mailItem
For Each x In Application.ActiveExplorer.Selection
If TypeName(x) = "MailItem" Then
Set mailItem = x
call fooMail(mailItem)
End If
Next
End Sub
Sub fooMail(ByRef mItem as Outlook.MailItem)
Debug.print mItem.Subject
End Sub
Sub AutoCancel(ByRef Item As Outlook.MeetingItem)
Dim strID As String
Dim olNS As Outlook.NameSpace
Dim oMeetingItem As Outlook.MeetingItem
Dim oResponse As Outlook.MeetingItem
Dim oAppointment As Outlook.AppointmentItem
strID = Item.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set oMeetingItem = olNS.GetItemFromID(strID)
Set oAppointment = oMeetingItem.GetAssociatedAppointment(False)
oAppointment.Delete
Set oAppointment = Nothing
Set oMeetingItem = Nothing
Set olNS = Nothing
End Sub
I have emails for appointments/cancellations coming in bulk to users that I'd like to automatically accept or cancel and then delete from their inbox. The accept method seems to work, but this method sends a debug report to the user for each cancellation pointing to the oAppointment.Delete line.
My thought is that it's erroring out under some circumstance where oMeetingItem.GetAssociatedAppointment is returning null, so it has nothing to delete. This is just a hunch though. Any ideas?
Yes, if you pass false to GetAssociatedAppointment, it will not create an appointment if it does not already exist.