I wrote a script to get my own sent email list. It worked until recently.
It works for 2021/07 or older months but but it cannot get any of 2021/08 emails.
I suppose it's caused by some cache reason (maybe some of the emails don't exist in local folders yet).
Sub get_Sent_mail()
On Error Resume Next
Dim olApp As Outlook.Application
Dim nmsName As NameSpace
Dim mail As mailitem
Dim text1 As String
sent_month = "2021/8"
Set olApp = Outlook.Application
Set nmsName = olApp.GetNamespace("MAPI")
For Each mail In nmsName.Folders("abc#efd.com").Folders("inbox").Folders("Sent Emails").Items
If InStr(mail.ReceivedTime, sent_month) <> 0 Then
Debug.Print mail.subject
End If
Next
End Sub
You are relying on the local settings to convert a datetime value mail.ReceivedTime to a string. That string might contain the month name instead of the number or a number with a without a leading 0. Or the year/month sequence can be different (m/y vs y/m)
You need to explicitly retrieve the month and year number and treat them as integers
If (Month(mail.ReceivedTime) = 8) AND (Year(mail.ReceivedTime) = 2021) Then
Debug.Print mail.subject
End If
Worse than that, your code is extremely inefficient - it is like writing a SQL query without a WHERE clause. You really need to use Items.Restrict:
set items = nmsName.Folders("abc#efd.com").Folders("inbox").Folders("Sent Emails").Items
set restrictedItems = items.Restrict("[ReceivedTime] >= '2021/08/01' AND [ReceivedTime] < '2021/09/01'")
for each mail in restrictedItems
Debug.Print mail.subject
next
Related
I want to loop through a list of email addresses and check if they have OOF's turned on (these will be other people's email addresses). Then if possible retrieve the OOF text.
I tried the options of getting the OOF through VBA but with my own trial and error and googling I can see that most people (and myself) realize it's only possible to get your own OOF information.
Sub Check_OOF()
Dim oNS As Outlook.NameSpace
Dim oStores As Outlook.Stores
Dim oStr As Outlook.Store
Dim oPrp As Outlook.PropertyAccessor
Set oNS = Outlook.GetNamespace("MAPI")
Set oStores = oNS.Stores
For Each oStr In oStores
If oStr.ExchangeStoreType = olPrimaryExchangeMailbox Then
Set oPrp = oStr.PropertyAccessor
MsgBox oPrp.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x661D000B")
End If
Next
End Sub
Is this possible with Outlook-Redemption? I can only see the syntax to interact with your own automatic reply.
You will need to use EWS - GetMailTips operation.
Also you can use Redemption, see RDOMailTips object for more information.
Thanks for pointing me in the right direction Eugene, also Dmitry thanks again for redemption.
I installed redemption by downloading here and installing it via the command line (thanks for the clear instructions). I'm using the RDOMailTips object which allowed me to loop through mailbox's and retrieve OOF messages and other helpful information.
Below is an example I quickly wrote to show the basic premise of looping through emails and getting OOF's text and start/end date.
Sub Get_OOF()
Dim session As Redemption.RDOSession
Dim arr As Variant
Set session = CreateObject("Redemption.RDOSession")
session.Logon
session.SkipAutodiscoverLookupInAD = True
arr = Array("user1#email.com", "user2#email.com", "user3#email.com")
For i = LBound(arr) To UBound(arr)
Set AdrEntry = session.AddressBook.ResolveName(arr(i))
Set mailtips = AdrEntry.GetMailTips
Debug.Print mailtips.OutOfOfficeMessage
Debug.Print mailtips.OutOfOfficeEndTime
Debug.Print mailtips.OutOfOfficeStartTime
Next i
Set session = Nothing
Set AdrEntry = Nothing
Set mailtips = Nothing
End Sub
Four things to note
If the person doesn't have an out of office it will return an empty string
If the person hasn't set out of office dates it will return 01/01/4501 which I assume is an error code formatted as a date
You will need to split the string from mailtips.OutOfOfficeMessage as it has a lot of formatting fluff around the out of office text
I didn't need to put my credentials in the parameters of AdrEntry.GetMailTips for this to work. But as the documentation says this is optional for EWS.
Can someone point out what I am missing here. Every time I run this it says that an object is required.
I apologize I feel like this is a very easy fix but I have been wrecking my brain for a while.
Basically what I am trying to accomplish is count how many emails are mark as high importance.
Again I feel like this is such a simple error but I am still learning this.
Sub CheckForImportance()
Dim myNs As Outlook.NameSpace
Dim infldr As Outlook.Folder
Dim impMail As Outlook.MailItem
Dim ttlcount As Integer
Set myNs = Application.GetNamespace("MAPI")
Set infldr = myNs.GetDefaultFolder(olFolderInbox)
Set impMail = infldr.Items
Set ttlcount = 0
If impMail.Importance = olImportanceHigh Then ttlImp = ttlImp + 1
MsgBox ("count:" & ttlImp)
End Sub
Outlook stores mail items, calendar items, tasks and so on in files it calls Stores. Sometimes people say mail items and so on are stored in PST files which is usually true. However, all PST files are stores but not all stores are PST files.
I remember when the default was for messages sent to any of your email addresses to be loaded to the same store. In that situation, Set infldr = myNs.GetDefaultFolder(olFolderInbox)was useful since the default Inbox was in that one store.
With Outlook 2016, and perhaps some other recent versions, the default is to have a separate store for each email address. Each of these stores is named for the email address, for example: “JohnDoe#hotmail.com” or “DoeJ#gmail.com”.
Copy this macro to an Outlook module and run it:
Sub DsplUsernameOfDefaultStore()
Dim NS As Outlook.NameSpace
Dim DefaultInboxFldr As MAPIFolder
Set NS = CreateObject("Outlook.Application").GetNamespace("MAPI")
Set DefaultInboxFldr = NS.GetDefaultFolder(olFolderInbox)
Debug.Print DefaultInboxFldr.Parent.Name
End Sub
On my system, this macro outputs “Outlook Data File”. This was the default store that came with Outlook but none of my emails are loaded to it.
You will need something like:
Set infldr = Session.Folders("Xxxx").Folders("Inbox")
where Xxxx is the name of the store containing the Inbox you wish to interrogate.
Below I have three alternative macros that count the number of high importance emails in an Inbox. Points of particular note:
Version 1 uses a For Each loop as I suggested in my comment. Version 2 uses a For IndexVariable loop. To my knowledge, neither type of For has an advantage over the other. I use whichever seems more convenient for the task at hand. Version 3 uses a filter. I have not found a use for the Outlook filter often enough to have become expert in its use so I normally use a For loop. olImportanceHigh is a constant with a value of 2. It appears you cannot use a constant within a Restrict string which is why it says [Importance] = 2.
I find Debug.Print much more convenient than MsgBox during development.
Come back with questions about my code as necessary.
Option Explicit
Sub CountHighImportanceEmails1()
Dim FldrInbox As Folder
Dim MailItemCrnt As MailItem
Dim NumEmailsHighImport As Long
Set FldrInbox = Session.Folders("Xxxx").Folders("Inbox")
NumEmailsHighImport = 0
For Each MailItemCrnt In FldrInbox.Items
If MailItemCrnt.Importance = olImportanceHigh Then
NumEmailsHighImport = NumEmailsHighImport + 1
End If
Next
Debug.Print "Number of high importance emails=" & NumEmailsHighImport
End Sub
Sub CountHighImportanceEmails2()
Dim FldrInbox As Folder
Dim InxMi As Long
Dim NumEmailsHighImport As Long
Set FldrInbox = Session.Folders("Xxxx").Folders("Inbox")
NumEmailsHighImport = 0
With FldrInbox
For InxMi = 1 To .Items.Count
If .Items(InxMi).Importance = olImportanceHigh Then
NumEmailsHighImport = NumEmailsHighImport + 1
End If
Next
End With
Debug.Print "Number of high importance emails=" & NumEmailsHighImport
End Sub
Sub CountHighImportanceEmails3()
Dim FldrInbox As Folder
Dim MailItemsHighImport As Items
Set FldrInbox = Session.Folders("Xxxx").Folders("Inbox")
Set MailItemsHighImport = FldrInbox.Items.Restrict("[Importance] = 2")
Debug.Print "Number of high importance emails=" & MailItemsHighImport.Count
End Sub
Example would be
Option Explicit
Public Sub Example()
Dim Inbox As Outlook.folder
Set Inbox = Application.Session.GetDefaultFolder( _
olFolderInbox)
Dim Filter As String
Filter = "[Importance] = 2"
Dim Items As Outlook.Items
Set Items = Inbox.Items.Restrict(Filter)
Debug.Print Items.Count
MsgBox Items.Count & " High importance Items are in " & Inbox.Name
End Sub
I have VBA code whose main functions are:
Load a form
Allow a user to choose a stock email response
Open a word document with the full response text
Create a reply using the text
Search the email and create a collection of strings containing corporate file numbers
Add the file numbers to an Excel list
Send the response
Now I want to save one copy of the sent item in a Windows folder, for each file number. I’ve been trying to wait until the item is sent and moved to Sent Items. The problem is that after calling the send method, the mailitem doesn’t send or move to Sent Items until after the code finishes so I end up in an infinite loop.
All the options I found involve using a class module and WithEvents. That would work if I wanted to copy every sent item to the folder. I can’t think of any criteria that would differentiate the emails created by this macro from normal emails. I could go into the Excel list of files, but that would bog everybody’s machine down on every send.
Is there a way to just have the email send find out when it has been sent and moved to sent items? My code to send, wait for it to go to sent items, and to save the emails is below. Note I have two global variables: cReply (Outlook.MailItem – the reply) and fNums (Collection – the file numbers).
I'm coding in Outlook 2016, but hope to move the module to Outlook 2010 at work.
Sub Send()
Dim badChar As String
badChar = "\/:*?™""® <>|.&##_+`©~;-+=^$!,'" & Chr(34)
Dim x As Integer
Dim fName As String
Dim inSentItems As Boolean
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olFldr As Outlook.MAPIFolder
Dim cSent As Outlook.MailItem
Dim sentMoment As Date
fName = cReply.Subject
For x = 1 To Len(badChar)
fName = Replace(fName, Mid(badChar, x, 1), "-")
Next x
Set olApp = GetObject(, "Outlook.Application")
Set olNS = olApp.GetNamespace("MAPI")
Set olFldr = olNS.GetDefaultFolder(olFolderSentMail)
inSentItems = True
x = olFldr.Items.Count
sentMoment = Now
cReply.Send
Do While olFldr.Items.Count <> x + 1
If Now - sentMoment > TimeValue("0:00:10") Then
inSentItems = False
Exit Do
End If
DoEvents
Loop
If inSentItems Then
Set cSent = olFldr.Items(olFldr.Items.Count)
For x = 1 To fNums.Count
cSent.SaveAs sentFldrPth & fNums.Item(x) & " - " & fName & ".msg", olMSG
Next x
'cSent.Delete
End If
Set olApp = Nothing
Set olNS = Nothing
Set olFldr = Nothing
End Sub
You could use SaveSentMessageFolder to save to another folder.
https://msdn.microsoft.com/en-us/library/office/ff868473.aspx
Monitor this other folder with ItemAdd code. You could move the mail to the Sent Items folder once done.
I am using the following code to retrieve and check an email, but outlook is returning the mail starting from 12/22, which is neither the latest nor the oldest, while on a co worker's machine its picking up the oldest mail.
Set oapp = CreateObject("Outlook.Application")
Set oMAPI = oapp.GetNamespace("MAPI")
Set oInbox = oMAPI.GetDefaultFolder(6)
oInbox.Display
Set oallmails = oInbox.Items
Set oreqemail = oallmails.GetFirst
For oTotalmail = 1 To oallmails.Count
ostringmatch = oreqemail.Subject
'Using regex function to match
'If MatchString(ostringmatch,"89554 Completed") Then
'End If
'Exit For
Set oreqemail = oallmails.GetNext
Next
Am I missing any outlook setting, as the code looks ok to me.
Thanks
To be sure that you get always the latest or oldest email in Outlook you need to use the Sort method of the Items class. It sorts the collection of items by the specified property. The index for the collection is reset to 1 upon completion of this method. The name of the property by which to sort, which may be enclosed in brackets, for example, "[CompanyName]".
Note, Sort only affects the order of items in a collection. It does not affect the order of items in an explorer view.
Set oapp = CreateObject("Outlook.Application")
Set oMAPI = oapp.GetNamespace("MAPI")
Set oInbox = oMAPI.GetDefaultFolder(6)
oInbox.Display
Set oallmails = oInbox.Items
oallmails.Sort "[RecievedTime]"
Set oreqemail = oallmails.GetFirst
For oTotalmail = 1 To oallmails.Count
ostringmatch = oreqemail.Subject
'Using regex function to match
'If MatchString(ostringmatch,"89554 Completed") Then
'End If
'Exit For
Set oreqemail = oallmails.GetNext
Next
See Outlook VBA: How to sort emails by date and open the latest email found? for more information.
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