Loop mail items within a Custom Search Folder

[Simon]

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 "
H:\Blue").

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.

 

[Simon]

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
DoEvents
Wend
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) & " - " &
CleanTheString(item.Subject)
Else
emailname = FileNamepath & Format(item.CreationTime, "yyyy-mm-dd
hh-nn-ss ") & item.SenderName & " to " & thesenderi & " - " &
CleanTheString(item.Subject)
End If

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

yeshtml:
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, "'", "") & " - " &
Atmt.FileName
Else
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
Else
MsgBox "I didn't find any attached files in your mail.", vbInformation, _
"Finished!"
End If

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

GetMail_err:
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
Next
'msgbox cleanedstring
CleanTheString = CleanedString
End Function