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