Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations derfloh on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Outlook 2k3 - Search across all PSTs problem

Status
Not open for further replies.

MakeItSo

Programmer
Oct 21, 2003
3,316
DE
Hi friends,

I am trying to accomplish a custom search macro, searching the subjects of mails for a keyword across all currently opened PSTs; Exchange account as well as opened local PSTs.

It does work - to a degree. However, it finds double entries. In addition to my Exchange account, I also manage our "info" account. So if my macro finds a mail in "sent items"; later when the search reaches the info account, it will again search "sent items", alas not the one of the info account but mine.

Here's the macro:
Code:
Private Sub SearchBtn_Click()
Dim pst As MAPIFolder, fol As MAPIFolder
Dim objSch As Search
Dim strF As String, sco As String
Dim strS As String, i As Integer, j As Integer, totl As Integer
Dim ns As Outlook.NameSpace, mi As MailItem
Dim boxes
Const strTag As String = "SubjectSearch"

boxes = Array("Inbox", "Sent Items")
On Error Resume Next

strF = "urn:schemas:mailheader:subject LIKE '%" & UserForm1.TextBox1.Text & "%'"

Set ns = Outlook.GetNamespace("MAPI")
Set itm = ns.GetDefaultFolder(olFolderInbox)
Set fol = itm.Folders("Found in all PSTs")
If Not (fol Is Nothing) Then
    itm.Folders.Delete ("Found in all PSTs")
End If
Set fol = itm.Folders.Add("Found in all PSTs")

For Each pst In Outlook.Session.Folders
    Err.Clear
    For j = 0 To 1
        Set objSch = pst[b].Application.[/b]AdvancedSearch(Scope:=boxes(j), Filter:=strF, SearchSubFolders:=True, Tag:=strTag)
        If objSch.Results.Count > 0 Then
            For i = 1 To objSch.Results.Count
                Set mi = objSch.Results.Item(i).Copy
                mi.Subject = "In " & pst.Name & ", " & boxes(j) & ": " & mi.Subject
                mi.Move fol
                totl = totl + 1
            Next i
        End If
    Next j
Next pst

MsgBox totl & IIf(totl = 1, "mail ", " mails ") & "found."
End
End Sub

See, I've already bolded the assumed culprit. The AdvancedSearch method needs the Application object.
So, in order to get the correct search result, I will probably have to change this:
Code:
Set objSch = pst[b].Application.[/b]AdvancedSearch(Scope:=boxes(j), Filter:=strF, SearchSubFolders:=True, Tag:=strTag)
Into something like this:
Code:
Set objSch = [b]Application.[/b]AdvancedSearch([b]Scope:=pst.FolderPath & ":" & boxes(j)[/b], Filter:=strF, SearchSubFolders:=True, Tag:=strTag)

I've tried googling to find out the correct syntax here, but to no avail.

Can any of you tell me how to direct the AdvancedSearch to the correct folder?

Thanks a lot!

Cheers,
MakeItSo

[navy]"We had to turn off that service to comply with the CDA Bill."[/navy]
- The Bastard Operator From Hell
 
Finally I got it!!!

2 things were needed.
1) For some reason I must not Dim objSch as Search.
2) this change did the trick:
Code:
For Each pst In Outlook.Session.Folders
    Err.Clear
    [b]For Each f2 In pst.Folders
        If f2.DefaultItemType = olMailItem Then
            sco = "'" & f2.FolderPath & "'"
            Set objSch = Application.AdvancedSearch(Scope:=sco, Filter:=strF, SearchSubFolders:=True, Tag:=strTag)[/b]
            If objSch.Results.Count > 0 Then

Really simple once you know it.
:)

[navy]"We had to turn off that service to comply with the CDA Bill."[/navy]
- The Bastard Operator From Hell
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top