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.
Related
With this bit of VBA code in MS Access I'm getting an error if its executed too often. The only way I've found to clear it is reboot my computer. Any idea why and what can I do?
Public Function HasOutlookAcct(strEmail As String) As Boolean
Dim OutMail As Object
Dim OutApp As OutLook.Application
Dim objNs As OutLook.NameSpace
Dim objAcc As Object
'https://stackoverflow.com/questions/67284852/outlook-vba-select-sender-account-when-new-email-is-created
Set OutApp = CreateObject("Outlook.Application")
Set objNs = OutApp.GetNamespace("MAPI")
For Each objAcc In objNs.Accounts
If objAcc.SmtpAddress = strEmail Then
HasOutlookAcct = True
Exit For
End If
Next
OutApp.Quit
Set objAcc = Nothing
Set objNs = Nothing
End Function
The code looks good. The NameSpace.Accounts property returns an Accounts collection object that represents all the Account objects in the current profile. I don't see any extensive or heavy usage of the Outlook object model, but creating a new Outlook Application instance in the method for checking whether a particular account is configured in Outlook or not is not the best way of using Outlook. Instead, I'd recommend running Outlook once at some point and getting all the configured emails for saving for future usage where necessary.
Also it makes sense to disable all COM add-ins to see whether it helps or not. The problem may be related to any specific COM add-in.
Appears the error is addressed by considering the user.
The assumption, based on my results, is Outlook is not cleaned up completely when the user's instance is closed with outApp.Quit.
When Outlook is open, outApp.Quit is not applied and Outlook remains open at the end.
When Outlook is not open, it is opened in the background and later closed with outApp.Quit.
There is zero or one instance of Outlook at any time.
Option Explicit
Public Function HasOutlookAcct(strEmail As String) As Boolean
'Reference Outlook nn.n Object Library
' Consistent early binding
Dim outApp As Outlook.Application
Dim objNs As Outlook.Namespace
Dim objAcc As Outlook.Account
Dim bCreated As Boolean
On Error Resume Next
Set outApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If outApp Is Nothing Then
bCreated = True
Set outApp = CreateObject("Outlook.Application")
End If
Set objNs = outApp.GetNamespace("MAPI")
For Each objAcc In objNs.Accounts
'Debug.Print objAcc.SmtpAddress
If objAcc.SmtpAddress = strEmail Then
HasOutlookAcct = True
Exit For
End If
'Set objAcc = Nothing ' Additional cleanup if needed
Next
If bCreated = True Then ' Outlook object had to be created
outApp.Quit
End If
'Set outApp = Nothing ' Additional cleanup if needed
Set objNs = Nothing
End Function
Private Sub HasOutlookAcct_Test()
Dim x As Boolean
Dim sEmail As String
sEmail = "someone#somewhere.com"
Dim i As Long
For i = 1 To 50
Debug.Print i & ": " & sEmail
x = HasOutlookAcct(sEmail)
Debug.Print " HasOutlookAcct: " & x
DoEvents
Next
Debug.Print "done"
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.
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.
I'm looking to set a Date on a field anytime an email is moved into a specific folder.
the field is custom called "Completed Date".
Could I get a little help on VBA code to set a custom field (date) when an item is moved into a folder (folder name is "Completed").
I'm ultimately looking to report on the time an item (custom form email) was received to the time it was completed (as per the action of moving the email to a completed folder.
Very rudimentary ticketing system, I'm very aware :) .
thanks,
A
Use ItemAdd http://www.outlookcode.com/article.aspx?id=62 where you reference the "Completed" folder.
Combine it with code like this http://www.vbaexpress.com/forum/showthread.php?5738-Need-to-Add-a-Userdefined-Property-to-Mail-Items
SAMPLE CODE
Change it so you do not update all items in the folder just the one item that triggered ItemAdd.
Option Explicit
Sub AddAUserDefinedProperty()
Dim olApplication As Outlook.Application
Dim olNameSpace As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim olItem As Object
Dim strDomain As String
Dim olProperty As Outlook.UserProperty
Set olApplication = New Outlook.Application
Set olNameSpace = olApplication.GetNamespace("Mapi")
Set olFolder = olNameSpace.GetDefaultFolder(olFolderJunk)
For Each olItem In olFolder.Items
strDomain = Mid(olItem.SenderEmailAddress, _
InStr(1, olItem.SenderEmailAddress, "#") + 1)
Set olProperty = olItem.UserProperties.Add("Domain", olText)
olProperty.Value = strDomain
Debug.Print olItem.SenderEmailAddress, olProperty.Value
olItem.Save
Next olItem
Set olApplication = Nothing
Set olNameSpace = Nothing
Set olFolder = Nothing
Set olProperty = Nothing
End Sub
Even more reference material here http://www.codeproject.com/Articles/427913/Using-User-Defined-Fields-in-Outlook
I'm building a macro that will run automatically when I move into the body of an email to check the email address of the recipient.
I cannot get the address of the recipient to load into a variable.
Sub BuildTable()
Dim myItem As Outlook.MailItem
Dim myRecipient As String
Set myItem = Application.CreateItem(olMailItem)
Set myRecipient = myItem.Recipient.Address
....
It seems that you are running in MS Outlook and in an Active Inspector, so perhaps:
Sub CheckAddresses()
Dim oEmail As Outlook.MailItem
Dim r As Recipient
Dim rList As Recipients
Set oEmail = Application.ActiveInspector.CurrentItem
Set rList = oEmail.Recipients
rList.ResolveAll
For Each r In rList
Debug.Print r.Address
Next
End Sub
I'm not sure what version of Outlook you are using, but according to Microsoft (http://msdn.microsoft.com/en-us/library/office/aa211006(v=office.11).aspx) you need to use the .Recipients(Index) to get a Recipient. From there you may be able to get the address. I also saw mention of some sort of ResolveAll method attached to .Recipients, though that referenced Outlook 2000 (eww).
Try doing
Dim myItem As Outlook.MailItem
Dim myRecipient as String
Set myItem = Application.CreateItem(olMailItem)
Set myRecipient = myItem.Recipients.Item(0).Address
This will give you the address of the first recipient (note I can't remember if VBA starts at index 0 or 1, if you get IndexOutOfRange, change to 1). If you need others, you're going to need to do a loop. Something like this:
For Each Recipient in myItem.Recipients
// do some stuff here
Next Recipient
Hope this helps.
This is what this segment of code ended up looking like:
Sub BuildTable1()
Dim oEmail As Outlook.MailItem
Set oEmail = Application.ActiveInspector.currentItem
Set xlApp = CreateObject("Excel.Application")
xlApp.Application.Visible = True
xlApp.workbooks.Open FileName:= file location
xlApp.WorkSheets("Contacts").Activate
xlApp.Range("A6").Value = oEmail.To
//filtering by value, copying, pasting, etc.
End Sub
-ZL