This question already has answers here:
Reference a folder not under the default inbox
(2 answers)
Closed 4 years ago.
I have created a folder on root, not under Inbox. What is the syntax to move to root folder?
I'm getting error:
The attempted operation failed
An Object Could not be found
Debug points to the below line myRestrictItems(i).Move myFolder.folders("Business")
Option Explicit
Public Sub Example()
Dim myNamespace As Outlook.NameSpace
Dim myFolder As Outlook.MAPIFolder
Dim myRestrictItems As Outlook.Items
Dim myItems As Outlook.Items
Dim myItem As Object
Dim i As Long
Dim Filter As String
Dim Msg As String
Set myNamespace = Application.GetNamespace("MAPI")
Set myFolder = myNamespace.GetDefaultFolder(olFolderInbox)
Set myItems = myFolder.Items
Filter = "#SQL=" & Chr(34) & "urn:schemas:httpmail:datereceived" & _
Chr(34) & " >= '01/01/2018' And " & _
Chr(34) & "urn:schemas:httpmail:datereceived" & _
Chr(34) & " < '23/03/2018' And " & _
Chr(34) & "urn:schemas:httpmail:fromname" & _
Chr(34) & "Like '%Jayakumar Krishnamoorthy%'"
Set myRestrictItems = myItems.Restrict(Filter)
For i = myRestrictItems.Count To 1 Step -1
myRestrictItems(i).Move myFolder.folders("Business")
'Msg = myRestrictItems.Count & " Items in " & myFolder.Name & " Folder"
'MsgBox (Msg)
Next
End Sub
The correct syntax should be
myRestrictItems(i).Move myNamespace.Folders("Business")
Also Move you msgbox outside the loop, Example
Set myRestrictItems = myItems.Restrict(Filter)
Msg = myRestrictItems.Count & " Items in " & myFolder.Name & " Folder, Move it?"
If MsgBox(Msg, vbYesNo) = vbYes Then
For i = myRestrictItems.Count To 1 Step -1
myRestrictItems(i).Move myNamespace.Folders("Business")
Next
End If
Run a quick loop through the folders to debug.print their names and any other properties you might find useful. The displayed name and internal name may not be the same.
Related
I've written some code that scans my default Outlook inbox for emails received today with a specific subject.
I then download the attachment for Outlook items that meet my criteria. I am having trouble designating the Restrict method to pull back items received today.
Here is what I have:
Sub DownloadAttachmentFirstUnreadEmail()
Dim oOlAp As Object, oOlns As Object, oOlInb As Object
Dim oOlItm As Object, oOlAtch As Object
Dim sFilter As String
Dim NewFileName As String
NewFileName = "C:\Temp\" & "CHG_Daily_Extract_" & Format(Date, "MM-DD-YYYY") & ".csv"
'~~> Get Outlook instance
Set oOlAp = GetObject(, "Outlook.application")
Set oOlns = oOlAp.GetNamespace("MAPI")
Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)
'Declare email item restriction
sFilter = "[ReceivedTime] = '" & Format(Date, "DDDDD HH:NN") & "'"
'Catch
If oOlInb.Items.Restrict(sFilter).Count > 0 Then
'~~> Loop thru today's emails
For Each oOlItm In oOlInb.Items.Restrict(sFilter)
'~> Check if the email subject matches
If oOlItm = "ASG CDAS Daily CHG Report" Then
'~~> Download the attachment
For Each oOlAtch In oOlItm.Attachments
oOlAtch.SaveAsFile NewFileName
Exit For
Next
End If
Exit For
Next
'Display if no emails today
Else: MsgBox "No items"
End If
End Sub
When I run the code, I consistently receive my catch message of "No items".
Please let me know if I am using the Restrict method incorrectly. Thank you so much for the help.
How about the following-
Filter = "#SQL=" & "%today(" & Chr(34) & ("urn:schemas:httpmail:datereceived") & _
Chr(34) & ")%
Or with Attachment
Filter = "#SQL=" & "%today(" & Chr(34) & ("urn:schemas:httpmail:datereceived") & _
Chr(34) & ")% AND " & _
Chr(34) & "urn:schemas:httpmail:hasattachment" & _
Chr(34) & "=1"
Example
Option Explicit
Private Sub Examples()
Dim olNs As Outlook.NameSpace
Dim Inbox As Outlook.MAPIFolder
Dim Items As Outlook.Items
Dim Msg As String
Dim i As Long
Dim Filter As String
Set olNs = Application.GetNamespace("MAPI")
Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
Filter = "#SQL=" & "%today(" & Chr(34) & ("urn:schemas:httpmail:datereceived") & _
Chr(34) & ")%"
Set Items = Inbox.Items.Restrict(Filter)
Msg = Items.Count & " Items in " & Inbox.Name
If MsgBox(Msg, vbYesNo) = vbYes Then
For i = Items.Count To 1 Step -1
Debug.Print Items(i) 'Immediate Window
Next
End If
End Sub
Filtering Items Using a Date-time Comparison MSDN
Outlook Date-time Macros
The date macros listed below return filter strings that compare the value of a given date-time property with a specified date in UTC; SchemaName is any valid date-time property referenced by namespace.
Note Outlook date-time macros can be used only in DASL queries.
Macro Syntax Description
today %today(" SchemaName")% Restricts for items with SchemaName
property value equal to today
More Examples Here
At work we are using Outlook 2016 and we have a shared folder. I am trying to count those emails in a subfolder of this shared folder which have a specified text in their body. I got one solution, but that is too slow (there is thousands of emails in one month).
My first solution, which works:
Sub SearchBody()
Dim myItems As Outlook.Items
Dim ShareInbox As Outlook.MAPIFolder
Dim myNamespace As Outlook.NameSpace
Dim myRecipient As Outlook.Recipient
Dim SubFolder As Object
Dim i As Integer
Dim myRestrictItems As Outlook.Items
Dim myItem As Object
Dim z As Integer
Dim dateStart As Date
i = 0
dateStart = DateTime.now
Set myNamespace = Application.GetNamespace("MAPI")
Set myRecipient = myNamespace.CreateRecipient("email#email.com")
Set ShareInbox = myNamespace.GetSharedDefaultFolder(myRecipient, olFolderInbox)
Set SubFolder = ShareInbox.Parent.Folders("SomeSubFolder")
Set myItems = SubFolder.Items
Set myRestrictItems = myItems.Restrict("[SentOn]>='2/1/2018' AND [SentOn]<'3/1/2018'")
For z = myRestrictItems.Count To 1 Step -1
If InStr(1, myRestrictItems(z).Body, "SomeStringToSearch") > 0 Then
i = i + 1
End If
Next
MsgBox i & vbNewLine & Format(DateTime.now - dateStart, "hh:mm:ss")
End Sub
So it works, but too slow (7-10 minutes).
My next code is:
Sub SearchBody2()
Dim table As Outlook.table
Dim filter As String
Dim myNamespace As Outlook.NameSpace
Dim myRecipient As Outlook.Recipient
Dim ShareInbox As Outlook.MAPIFolder
Dim SubFolder As Object
Dim row As Outlook.row
Dim myRestrictItems As Outlook.Items
Dim myItems As Outlook.Items
filter = "#SQL=" & Chr(34) & "urn:schemas:httpmail:textdescription" & Chr(34) & " like '%SomeStringToSearch%'"
Set myNamespace = Application.GetNamespace("MAPI")
Set myRecipient = myNamespace.CreateRecipient("email#email.com")
Set ShareInbox = myNamespace.GetSharedDefaultFolder(myRecipient, olFolderInbox)
Set SubFolder = ShareInbox.Parent.Folders("SomeSubFolder")
Set table = SubFolder.GetTable(filter, Outlook.OlTableContents.olUserItems)
MsgBox table.GetRowCount
End Sub
(I know that in this code there is no filter for date like in the first)
This works too, until it reaches 250 hits: it stops then.
Is there any solution to avoid the stop of the search? I am not admin of this shared folder, so I have no rights for settings.
Folder tree:
Your SubFolder Should be Set SubFolder = ShareInbox.folders("SomeSubFolder")
To add Date to your filter then example would be
filter = "#SQL=" & Chr(34) & "urn:schemas:httpmail:datereceived" & _
Chr(34) & " >= '02/01/2018' And " & _
Chr(34) & "urn:schemas:httpmail:datereceived" & _
Chr(34) & " < '02/28/2018' And " & _
Chr(34) & "urn:schemas:httpmail:textdescription" & _
Chr(34) & "Like '%SomeStringToSearch%'"
If your having trouble working with shared folder then you can use CurrentFolder Property which represents the current folder displayed in the explorer
Below example has loop just for testing- deleted if not need it
Option Explicit
Public Sub Example()
Dim TargetFolder As Outlook.MAPIFolder
Dim Items As Outlook.Items
Dim i As Long
If TargetFolder Is Nothing Then Set TargetFolder = ActiveExplorer.CurrentFolder
Debug.Print TargetFolder.Name
Dim Filter As String
Filter = "#SQL=" & Chr(34) & "urn:schemas:httpmail:datereceived" & _
Chr(34) & " >= '02/01/2018' AND " & _
Chr(34) & "urn:schemas:httpmail:datereceived" & _
Chr(34) & " < '02/28/2018' AND " & _
Chr(34) & "urn:schemas:httpmail:textdescription" & _
Chr(34) & "Like '%SomeStringToSearch%'"
Set Items = TargetFolder.Items.Restrict(Filter)
MsgBox (Items.Count & " Items in " & TargetFolder.Name)
Debug.Print Items.Count & " Items in " & TargetFolder.Name
For i = Items.Count To 1 Step -1
DoEvents
Debug.Print Items(i).Subject 'Immediate Window
Next
End Sub
I want to download all attachments from emails which are both unread and received from the specific sender in MS Outlook.
I found a code, which downloads all attachments from all unread emails.
Downloading Attachments from Unread Emails of MS Outlook and tried to adapt it.
However, filter is not working properly. It shows that there are no such e-mails.
Filter = "[Unread] = True And [SenderEmailAddress] = 'yrybchuk#gmail.com'"
Below is the entire code:
Option Explicit
Public Sub Example()
Dim oOlAp As Object
Dim olNs As Outlook.Namespace
Dim Inbox As Outlook.MAPIFolder
Dim Items As Outlook.Items
Dim Item As Outlook.MailItem
Dim Atmt As Attachment
Dim Filter As String
Dim FilePath As String
Dim AtmtName As String
Dim i As Long
'// Set Inbox Reference
Set oOlAp = GetObject(, "Outlook.application")
Set olNs = oOlAp.GetNamespace("MAPI")
Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
FilePath = "C:\Users\irybchuk\Documents\"
Filter = "[Unread] = True And [SenderEmailAddress] = 'yrybchuk#gmail.com'"
Set Items = Inbox.Items.Restrict(Filter)
'// Loop through backwards
For i = Items.Count To 1 Step -1
Set Item = Items.Item(i)
DoEvents
If Item.Class = olMail Then
Debug.Print Item.Subject ' Immediate Window
For Each Atmt In Item.Attachments
AtmtName = FilePath & Atmt.FileName
Atmt.SaveAsFile AtmtName
Next
End If
Next
Set Inbox = Nothing
Set Items = Nothing
Set Item = Nothing
Set Atmt = Nothing
Set olNs = Nothing
End Sub
I believe that here: How to filter items sendername from Items_ItemAdd Events? could be described possible solution how to change filter line. However, I couldn't do it.
Your filter seems to work for me but here is different one SQL DASL syntax you can use
Filter = "#SQL=" & Chr(34) & "urn:schemas:httpmail:fromname" & _
Chr(34) & " Like '%yrybchuk#gmail.com%' AND " & _
Chr(34) & "urn:schemas:httpmail:read" & _
Chr(34) & "=0"
Or better yet one with the attachment Restricted Filter to improve your loop
Filter = "#SQL=" & Chr(34) & "urn:schemas:httpmail:fromname" & _
Chr(34) & " Like '%yrybchuk#gmail.com%' AND " & _
Chr(34) & "urn:schemas:httpmail:hasattachment" & _
Chr(34) & "=1 AND " & _
Chr(34) & "urn:schemas:httpmail:read" & _
Chr(34) & "=0"
remember to update %yrybchuk#gmail.com%
FYI
If code is being run from Outlook then you don't need
oOlAp = GetObject(, "Outlook.application")
I am trying to download an Excel attachment with the subject keyword.
I managed to create a code but sometimes it is giving Error 440 "Array Index out of Bounds".
The code got stuck in this part.
If Items(i).Class = Outlook.OlObjectClass.OlMail Then
Here is the code
Sub Attachment()
Dim N1 As String
Dim En As String
En = CStr(Environ("USERPROFILE"))
saveFolder = En & "\Desktop\"
N1 = "Mail Attachment"
If Len(Dir(saveFolder & N1, vbDirectory)) = 0 Then
MkDir (saveFolder & N1)
End If
Call Test01
End Sub
Private Sub Test01()
Dim Inbox As Outlook.Folder
Dim obj As Object
Dim Items As Outlook.Items
Dim Attach As Object
Dim MailItem As Outlook.MailItem
Dim i As Long
Dim Filter As String
Dim saveFolder As String, pathLocation As String
Dim dateFormat As String
Dim dateCreated As String
Dim strNewFolderName As String
Dim Creation As String
Const Filetype1 As String = "xlsx"
Const Filetype2 As String = "xlsm"
Const Filetype3 As String = "xlsb"
Const Filetype4 As String = "xls"
Dim Env As String
Env = CStr(Environ("USERPROFILE"))
saveFolder = Env & "\Desktop\Mentor Training\"
Set Inbox = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
'If Inbox.Items.Restrict("[UnRead] = True").Count = 0 Then
' MsgBox "No Mentor Training Mail In Inbox"
' Exit Sub
'End If
Filter = "#SQL=" & Chr(34) & "urn:schemas:httpmail:datereceived" & _
Chr(34) & " >= '4/2/2017' AND " & _
Chr(34) & "urn:schemas:httpmail:hasattachment" & _
Chr(34) & "=1 AND" & Chr(34) & _
Chr(34) & "urn:schemas:httpmail:read" & _
Chr(34) & "= 0"
Set Items = Inbox.Items.Restrict(Filter)
For i = 1 To Items.Count
If Items(i).Class = Outlook.OlObjectClass.olMail Then
Set obj = Items(i)
Debug.Print obj.subject
For Each Attach In obj.Attachments
If Right(LCase(Attach.fileName), Len(Filetype1)) = Filetype1 Then 'For searching only excel files
dateFormat = Format(obj.ReceivedTime(), "dd-mm-yyyy hh-mm")
Attach.SaveAsFile saveFolder & "(" & dateFormat & ")" & " " & Attach
End If
If Right(LCase(Attach.fileName), Len(Filetype2)) = Filetype2 Then 'For searching only excel files
dateFormat = Format(obj.ReceivedTime(), "dd-mm-yyyy hh-mm")
Attach.SaveAsFile saveFolder & "(" & dateFormat & ")" & " " & Attach
End If
If Right(LCase(Attach.fileName), Len(Filetype3)) = Filetype3 Then 'For searching only excel files
dateFormat = Format(obj.ReceivedTime(), "dd-mm-yyyy hh-mm")
Attach.SaveAsFile saveFolder & "(" & dateFormat & ")" & " " & Attach
End If
If Right(LCase(Attach.fileName), Len(Filetype4)) = Filetype4 Then 'For searching only excel files
dateFormat = Format(obj.ReceivedTime(), "dd-mm-yyyy hh-mm")
Attach.SaveAsFile saveFolder & "(" & dateFormat & ")" & " " & Attach
End If
obj.UnRead = False
DoEvents
obj.Save
Next
End If
Next
MsgBox "Attachment Saved"
End Sub
It was my understanding that arrays in vba started at 0 by default. So if there is only one item in the list it will be located at Items(0). And since your for statement starts by looking at Items(1) it will throw that error. Changing it to:
For i = 0 To Items.Count - 1
should work I believe.
The filter may return zero items.
Set Items = Inbox.Items.Restrict(Filter)
If Items.Count > 0 then
For i = 1 To Items.Count
No need for setting up multiple dot objects simply use
If Items(i).Class = olMail Then
You may also wanna set your objects to nothing, once your done with them...
Set Inbox = Nothing
Set obj = Nothing
Set Items = Nothing
Set Attach = Nothing
Set MailItem = Nothing
End Sub
The following code which get all uncategorised items from outlook however it returns all the items including appointments and meetings. I need a code which returns only messages which are not categorised.
Sub NullCategoryRestriction()
Dim oFolder As Outlook.Folder
Dim oItems As Outlook.Items
Dim Filter As String
'DASL Filter can test for null property.
'This will return all items that have no category.
Filter = "#SQL=" & Chr(34) & _
"urn:schemas-microsoft-com:office:office#Keywords" & _
Chr(34) & " is null"
Set oFolder = Application.ActiveExplorer.CurrentFolder
Set oItems = oFolder.Items.Restrict(Filter)
Debug.Print oItems.Count
End Sub
You need to include the MessageClass property check to the filter as well. The property returns a string representing the message class for the Outlook item.
The following code worked for me.
Filter = "#SQL=" & Chr(34) & _
"urn:schemas-microsoft-com:office:office#Keywords" & _
Chr(34) & " is null"
Set ml = ml.Items.Restrict(Filter)
For i = ml.Count To 1 Step -1
If TypeOf ml(i) Is MailItem Then
End if
Next
There may be no noticeable gain in efficiency but you could apply a second restrict rather than checking each item with If TypeOf ml(i) Is MailItem Then.
Option Explicit
Sub NullCategoryRestriction_MailItems()
Dim oFolder As Folder
Dim oItems As Items
Dim ml As Items
Dim i As Long
Dim oFilter As String
Dim oFilter2 As String
Debug.Print
'DASL Filter can test for null property.
'This will return all items that have no category.
' https://learn.microsoft.com/en-us/office/vba/outlook/How-to/Search-and-Filter/filter-items-that-do-not-have-categories
oFilter = "#SQL=" & Chr(34) & _
"urn:schemas-microsoft-com:office:office#Keywords" & _
Chr(34) & " is null"
Debug.Print " " & oFilter
Set oFolder = ActiveExplorer.CurrentFolder
Set oItems = oFolder.Items.Restrict(oFilter)
Debug.Print " oItems.Count: " & oItems.Count
'This will return mailitems
' https://learn.microsoft.com/en-us/office/vba/outlook/concepts/forms/item-types-and-message-classes
oFilter2 = "[MessageClass] = 'IPM.Note'"
Debug.Print " " & oFilter2
Set ml = oItems.Restrict(oFilter2)
Debug.Print " ml.Count: " & ml.Count
For i = ml.Count To 1 Step -1
' If TypeOf ml(i) Is mailItem Then
Debug.Print ml(i).MessageClass & ": " & ml(i).subject
'End If
Next
End Sub
The TypeOf test is no longer necessary.