Outlook mail folder showing nothing - vba

I am searching for Outlook mail.
Dim Fldr As Outlook.MAPIFolder
Dim olMail As Variant
Dim myTasks As Outlook.Items
Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
Set myTasks = Fldr.Items
Set olMail = myTasks.Find("[Subject] = ""8094676688""")
In myTasks and olMail I am geting nothing.


Think, this case is better to do via loop
Dim count as Long
count=0
For Each x in myTasks
If x.Subject ="8094676688" Then
count=count+1
ReDim Preserve olMail (count)
olMail (count)=x
End If
next x

Related

Search for a specific Outlook email

What Visual Basic for Applications method will allow me to find a specific Outlook email so that I can access data from it like its message content - perhaps by searching by the subject of the email?

Items.Find Method is a alternative solution, you can use VBA string search function:
Sub sofWorkWithOutlook20082550()
Dim outlookApp
Dim olNs As Outlook.Namespace
Dim Fldr As Outlook.MAPIFolder
Dim olMail As Variant
Dim myTasks
Dim sir() As String
'Set outlookApp = New Outlook.Application
Set outlookApp = CreateObject("Outlook.Application")
Set olNs = outlookApp.GetNamespace("MAPI")
Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
Set myTasks = Fldr.Items
'
'Set olMail = myTasks.Find("[Subject] = ""123456""")
'
For Each olMail In myTasks
'
If (InStr(1, olMail.Body, "My-Text-to-Search", vbTextCompare) > 0) Then
olMail.Display
Exit For
End If
Next
End Sub
PS: change "My-Text-to-Search" to some string you have in your email
Acess this site for more information: Items.Find Method

Why does loop in email inbox from latest email skip files?

I am trying to download the email attachments in Outlook inbox based on received date. My code downloads attachments, however it skips files.
For example: I was trying to loop the email from the latest email (Received date:01/14/2019). After looping around 10-15 emails, it suddenly jumps to read the email received on 12/07/2018.
Sub saveemailattachment()
'Application setup
Dim objOL As Outlook.Application
Set objOL = New Outlook.Application
Dim ONS As Outlook.Namespace
Set ONS = objOL.GetNamespace("MAPI")
Dim olfolder As Outlook.Folder
Set olfolder = ONS.GetDefaultFolder(olFolderInbox)
Dim olmail As Outlook.MailItem
Set olmail = objOL.CreateItem(olMailItem)
Dim olattachment As Outlook.Attachment
Dim i As Long
Dim filename As String
Dim VAR As Date
'Loop through all item in Inbox
For i = olfolder.Items.Count To 1 Step -1 'Iterates from the end backwards
Set olmail = olfolder.Items(i)
For Each olmail In olfolder
VAR = Format(olmail.ReceivedTime, "MM/DD/YYYY")
filename = olmail.Subject
If VAR = "1/14/2019" Then
For Each olattachment In olmail.Attachments
olattachment.SaveAsFile "C:\Users\Rui_Gaalh\Desktop\Email attachment\" & olattachment.filename
Next
Else
End If
'Mark email as read
olmail.UnRead = False
DoEvents
olmail.Save
Next
Next
MsgBox "DONE"
End Sub

Do not loop through all items in a folder - some folders can have ten of thousands of messages. Use Items.Find/FindNext or Items.Restrict with a query like "[ReceivedTime] >= '2019-01-14' AND [ReceivedTime] < '2019-01-15'".
In case of Items.Find/FindNext, you won't have a problem with skipped emails. In case of Items.Restrict, use a down loop from count down to 1 step -1.

If you are just trying to save Email Attachments that was received on "1/14/2019" then No need for
For Each olmail In olfolder
Next
When you are already using
For i = olfolder.Items.Count To 1 Step -1
next
Here is another one objOL.CreateItem(olMailItem)?? remove it, also Dim olmail as a generic Object - there are objects other than MailItem in your Inbox.
Dim olmail As Outlook.MailItem
Set olmail = objOL.CreateItem(olMailItem)
Set olMail with in the loop then check if the olMail is MailItem
Example
Option Explicit
Sub saveemailattachment()
'Application setup
Dim objOL As Outlook.Application
Set objOL = New Outlook.Application
Dim ONS As Outlook.NameSpace
Set ONS = objOL.GetNamespace("MAPI")
Dim olfolder As Outlook.Folder
Set olfolder = ONS.GetDefaultFolder(olFolderInbox)
Dim olmail As Object
Dim olattachment As Outlook.attachment
Dim i As Long
Dim filename As String
Dim VAR As Date
'Loop through all item in Inbox
For i = olfolder.items.Count To 1 Step -1 'Iterates from the end backwards
DoEvents
Set olmail = olfolder.items(i)
If TypeOf olmail Is Outlook.MailItem Then
VAR = Format(olmail.ReceivedTime, "MM/DD/YYYY")
filename = olmail.Subject
If VAR = "1/14/2019" Then
For Each olattachment In olmail.Attachments
olattachment.SaveAsFile _
"C:\Users\Rui_Gaalh\Desktop\Email attachment\" _
& olattachment.filename
Next
'Mark email as read
olmail.UnRead = False
End If
End If
Next
MsgBox "DONE"
End Sub
You should also look into Items.Restrict method
https://stackoverflow.com/a/48311864/4539709
Items.Restrict method is an alternative to using the Find method or FindNext method to iterate over specific items within a collection. The Find or FindNext methods are faster than filtering if there are a small number of items. The Restrict method is significantly faster if there is a large number of items in the collection, especially if only a few items in a large collection are expected to be found.
Filtering Items Using a String Comparison that DASL filters support includes equivalence, prefix, phrase, and substring matching. Note that when you filter on the Subject property, prefixes such as "RE: " and "FW: " are ignored.

Thanks for all your suggestions. The code works perfectly. Please find the final code below:
Option Explicit
Sub saveemailattachment()
'Application setup
Dim objOL As Outlook.Application
Set objOL = New Outlook.Application
Dim ONS As Outlook.Namespace
Set ONS = objOL.GetNamespace("MAPI")
Dim olfolder As Outlook.Folder
Set olfolder = ONS.GetDefaultFolder(olFolderInbox)
Dim olmail As Object
Dim olattachment As Outlook.Attachment
Dim i As Long
Dim InboxMsg As Object
Dim filename As String
'Set variables
Dim Sunday As Date
Dim Monday As Date
Dim Savefolder As String
Dim VAR As Date
Dim Timestamp As String
Monday = ThisWorkbook.Worksheets(1).Range("B2")
Sunday = ThisWorkbook.Worksheets(1).Range("B3")
Savefolder = ThisWorkbook.Worksheets(1).Range("B4")
'Loop through all item in Inbox
For i = olfolder.Items.Count To 1 Step -1 'Iterates from the end backwards
DoEvents
Set olmail = olfolder.Items(i)
Application.Wait (Now + TimeValue("0:00:01"))
'Check if olmail is emailitem
If TypeOf olmail Is Outlook.MailItem Then
'Set time fram
VAR = olmail.ReceivedTime 'Set Received time
Timestamp = Format(olmail.ReceivedTime, "YYYY-MM-DD-hhmmss") 'Set timestamp format
If VAR <= Sunday And VAR >= Monday Then
For Each olattachment In olmail.Attachments
Application.Wait (Now + TimeValue("0:00:01"))
'Download excel file and non-L10 file only
If (Right(olattachment.filename, 4) = "xlsx" Or Right(olattachment.filename, 3) = "xls")Then
'Set file name
filename = Timestamp & "_" & olattachment.filename
'Download email
olattachment.SaveAsFile Savefolder & "\" & filename
Application.Wait (Now + TimeValue("0:00:02"))
End If
Next
Else
End If
'Mark email as read
olmail.UnRead = False
DoEvents
olmail.Save
Else
End If
Next
MsgBox "DONE"
End Sub

Excel VBA Outlook search Multiple Criteria (ID and Date)

This code was derived from Excel VBA for searching in mails of Outlook.
I made adjustments to make it search a SharedMailbox which does work but the issue is that the mailbox is receiving hundreds of emails a day which makes searching time a bit longer for my liking (we have emails from early last year even). I would like to impose a 2nd search criteria, this time a date limit, like only search emails that are 2 to 3 days old.
Here is what I got:
Dim outlookapp
Dim olNs As Outlook.Namespace
Dim Fldr As Outlook.MAPIFolder
Dim olMail As Variant
Dim myTasks
Dim projIDsearch As String
Dim myRecipient As Outlook.Recipient
Dim days2ago As Date
Set outlookapp = CreateObject("Outlook.Application")
Set olNs = outlookapp.GetNamespace("MAPI")
Set myRecipient = olNs.CreateRecipient("SharedMailboxName")
myRecipient.Resolve
'Set Fldr = olNs.GetDefaultFolder(olFolderInbox).Folders("x")
Set Fldr = olNs.GetSharedDefaultFolder(myRecipient, olFolderInbox)
Set myTasks = Fldr.Items
projIDsearch = ActiveCell.Cells(1, 4)
days2ago = DateTime.Now - 3
For Each olMail In myTasks
'If olMail.ReceivedTime > days2ago Then
If (InStr(1, olMail.Subject, projIDsearch, vbTextCompare) > 0) Then
olMail.Display
'Exit For
End If
Next
I've looked around and found the .ReceivedTime property, which sounds like the thing that I need but I'm having a struggle on how to incorporate it into the code.
Actually I don't even know how a Variant(olMail) is able to accept the .display method and .subject property.
These are the codes that I've added but they don't seem to work:
days2ago = DateTime.Now - 3
and
If olMail.ReceivedTime > days2ago Then

You can Restrict the number of items in the loop. https://msdn.microsoft.com/en-us/library/office/ff869597.aspx
Sub test()
Dim outlookapp As Object
Dim olNs As Outlook.Namespace
Dim myFldr As Outlook.Folder
Dim objMail As Object
Dim myTasks As Outlook.Items
Dim daysAgo As Long
Dim projIDsearch As String
Dim myRecipient As Outlook.Recipient
Set outlookapp = CreateObject("Outlook.Application")
Set olNs = outlookapp.GetNamespace("MAPI")
Set myRecipient = olNs.CreateRecipient("SharedMailboxName")
myRecipient.Resolve
Set myFldr = olNs.GetSharedDefaultFolder(myRecipient, olFolderInbox)
projIDsearch = ActiveCell.Cells(1, 4)
' Restrict search to daysAgo
daysAgo = 3
Set myTasks = myFldr.Items.Restrict("[ReceivedTime]>'" & Format(Date - daysAgo, "DDDDD HH:NN") & "'")
For Each objMail In myTasks
If (InStr(1, objMail.Subject, projIDsearch, vbTextCompare) > 0) Then
objMail.Display
End If
Next
End Sub

Type Mismatch error when items in Inbox declared as mailitems

I have the following VBA code in Outlook to move mail to a personal folder if it is old. Here is the code:
I get an exception on the line Next objItem (looking at the watch it is set to nothing).
What would cause objItem to be null and thus cause a Type Mismatch exception in the Next objItem line?
Sub MoveOldMailFromInbox()
Dim objFolder As Outlook.MAPIFolder
Dim objNS As Outlook.NameSpace, objItem As Outlook.MailItem, mail As Outlook.MailItem
Set objNS = Application.GetNamespace("MAPI")
Dim Inbox As MAPIFolder
Set Inbox = objNS.GetDefaultFolder(olFolderInbox)
Dim mailToMove As New Collection
Dim EightyFiveDaysAgo As Date
EightyFiveDaysAgo = DateAdd("d", -85, Date)
Set objFolder = objNS.Folders("PersonalFolders").Folders("InboxOlderThan85Days")
If objFolder Is Nothing Then
MsgBox "This folder doesn't exist!", vbOKOnly + vbExclamation, "INVALID FOLDER"
End If
For Each objItem In Inbox.Items
If objFolder.DefaultItemType = olMailItem Then
If objItem.Class = olMail And objItem.ReceivedTime < EightyFiveDaysAgo Then
mailToMove.Add objItem
End If
End If
Next objItem
For Each mail In mailToMove
mail.UnRead = False
mail.Move objFolder
Next mail
Set objItem = Nothing
Set objFolder = Nothing
Set objNS = Nothing
End Sub

You're iterating through Inbox.Items but your variable objItem is defined as MailItem - an item in your inbox might not always be a MailItem.
Try
Dim objItem as Object

Setting outlook.attachment = Mail item attachment

I am trying to write a script that saves attachments to a directory. When I run it, I get an error message "type mismatch" and the line Set olAtt = olMi.Attachments is highlighted. Could someone advise?
Sub SaveAttachments()
Dim olApp As Outlook.Application
Dim olNs As Namespace
Dim Fldr As MAPIFolder
Dim MoveToFldr As MAPIFolder
Dim olMi As Outlook.MailItem
Dim olAtt As Outlook.Attachment
Dim MyPath As String
Dim i As Long
Dim j As Long
Dim filesavename As String
Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
Set MoveToFldr = Fldr.Folders("Survey")
MyPath = "C:\Users\temp"
For i = (Fldr.Items.Count - 150) To Fldr.Items.Count
Set olMi = Fldr.Items(i)
If InStr(1, olMi.Subject, "Survey") > 0 Then
j = olMi.Attachments.Count
Set olAtt = olMi.Attachments
filesavename = MyPath & olAtt.Filename
olAtt.SaveAsFile filesavename
olMi.Save
olMi.Move MoveToFldr
End If
Next i
Set olAtt = Nothing
Set olMi = Nothing
Set Fldr = Nothing
Set MoveToFldr = Nothing
Set olNs = Nothing
Set olApp = Nothing
End Sub

olAtt is declared as a Outlook.Attachment (singular).
olMi.Attachments is a collection of attachments.