Loop mail items within a Custom Search Folder



Hi I'm using Outlook 2003.

From within a custom search folder, I'm wanting to loop through all mail
items and save each item in HTML format to a fixed directory (say "

I'm having problems trying to work out how to call the custom search folder
(lets say its called "Platinum")

Clearly I cant use Set mpfInbox =
myOlApp.GetNamespace("MAPI").GetDefaultFolder(olFolder etc etc)

I've found very little information on doing this...any idea?

Ken Slovak - [MVP - Outlook]

How is this search folder created? If it's by code using the
Application.AdvancedSearch() method then when it's first being created and
saved you get back a MAPIFolder reference for that search folder. You can
then save the EntryID of that MAPIFolder and use that to get back the folder
at any subsequent time by using NameSpace.GetFolderFromID().

Otherwise there's no access to search folders in the Outlook object model
until Outlook 2007 or by using Redemption or some other API that lets you
access the Store object and dig down from there to the search folders.


Hi thanks for your help...much appreciated. I had planned on using search
folders, but will now use the AdvancedSearch() method as per your
suggestion. I'm wondering if you can point me in the right direct to replace
"Set Inbox = ns.GetDefaultFolder(olFolderInbox)" with code that will use the
items found in the advancedsearch I've built.

I've spent hours searching the net and can't find any good notes on this.

My two queries are:

1. In application.AdvancedSearch how can I search for all 'Green' flag
items? I'm trying
Const strF As String = "urn:schemas:flagicon = olgreenFlagIcon"
or variations of but I'm not having any luck.

The seach code is:
Dim sch As Outlook.Search
Dim rsts As Outlook.Results
Dim i As Integer
blnSearchComp = False
'Const strF As String = "urn:schemas:flagicon = olgreenFlagIcon"
Const strF As String = "urn:schemas:mailheader:subject = 'test'"
Const strS As String = "Inbox"
Set sch = Application.AdvancedSearch(strS, strF)
While blnSearchComp = False
Set rsts = sch.Results

2. In my code below, how do I save the EntryID of that MAPIFolder and use
NameSpace.GetFolderFromID() to call it back?

Sub GetMails()

'On Error GoTo GetMail_err
Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim item As Object
Dim Atmt As attachment
Dim FileName As String
Dim i As Integer
Dim SubFolder As MAPIFolder
Dim FileNamepath As String
Dim varResponse As VbMsgBoxResult
Dim directoryselected As Boolean

Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox) ' Need to change this line
FileNamepath = "h:\Email Attachments\"
thesender = "Simon"
thesenderi = "SF"
i = 0
y = 0

If Inbox.Items.count = 0 Then
MsgBox "There are no messages in the Inbox.", vbInformation, _
"Nothing Found"
Exit Sub
End If

For Each item In Inbox.Items
If item.ReceivedByName = "" Then thename = Left(CleanTheString(item.To),
15) Else thename = Left(CleanTheString(item.ReceivedByName), 15)

If item.SenderName = thesender Then
emailname = FileNamepath & Format(item.CreationTime, "yyyy-mm-dd
hh-nn-ss ") & thesenderi & " to " & CleanTheString(thename) & " - " &
emailname = FileNamepath & Format(item.CreationTime, "yyyy-mm-dd
hh-nn-ss ") & item.SenderName & " to " & thesenderi & " - " &
End If

'item.SaveAs emailname & ".msg", olMSG
On Error GoTo nohtml
item.SaveAs emailname & ".htm", olHTML
GoTo yeshtml
On Error GoTo 0
item.SaveAs emailname & ".txt", olTXT
Resume Next

On Error GoTo GetMail_err

For Each Atmt In item.Attachments
If item.SenderName = thesender Then
FileName = FileNamepath & Format(item.CreationTime, "yyyy-mm-dd
hh-nn-ss ") & thesenderi & " to " & Replace(thename, "'", "") & " - " &
FileName = FileNamepath & Format(item.CreationTime, "yyyy-mm-dd
hh-nn-ss ") & item.SenderName & " to " & thesenderi & " - " & Atmt.FileName
End If
Atmt.SaveAsFile FileName
i = i + 1
Next Atmt
y = y + 1
Next item

If i > 0 Then
varResponse = MsgBox("I found " & y & " email items." _
& vbCrLf & "I found " & i & " attached files." _
& vbCrLf & "I have saved them into the " & FileNamepath & " folder." _
& vbCrLf & vbCrLf & "Would you like to view the files now?" _
, vbQuestion + vbYesNo, "Finished!")
If varResponse = vbYes Then
Shell "Explorer.exe /e," & FileNamepath & "", vbNormalFocus
End If
MsgBox "I didn't find any attached files in your mail.", vbInformation, _
End If

Set Atmt = Nothing
Set item = Nothing
Set ns = Nothing
Exit Sub

MsgBox "An unexpected error has occurred." _
& vbCrLf & "Please note and report the following information." _
& vbCrLf & "Macro Name: GetAttachments" _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description: " & Err.Description _
, vbCritical, "Error!"
Resume GetAttachments_exit

End Sub

Function CleanTheString(theString)
'msgbox thestring
strAlphaNumeric = "
0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" 'Used to
check for numeric characters.
For i = 1 To Len(theString)
strChar = Mid(theString, i, 1)
If InStr(strAlphaNumeric, strChar) Then
CleanedString = CleanedString & strChar
End If
'msgbox cleanedstring
CleanTheString = CleanedString
End Function

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question