Search Folders and VBA
 

My issue is that I am planning on rolling out an archive solution and
would like to use the search folders to identify all messages that are
about to be deleted by the retention plan to give the users an
opportunity to move them to the archive. For Example "Before 2000"

Lets start with the good news!!

I was able to not only programmatically create the search folders I
need but also change the view to show the total number of items instead
of the unread number.

I know I cannot edit the folder but must delete and recreate.

This can only be done with CDO or Extended Mapi.

I found an example of a CDO function that looks up the ID by name, but
when I use it it only cycles through the visible folders.

I STILL CANNOT FIND THE ID OF THE SEARCH FOLDER.

I think that I need a CDO funtion that will search HIDDEN folders for
the ID of the search folder by name.

Any help would be apreciated.

Search Folders and VBA
 

Sample CDO function I found that searches for folder by name:

Public Function GetFolderByName( _
ByVal CdoSession As MAPI.Session, _
ByVal strFolderName As String, _
Optional ByVal CdoFolderParent As MAPI.Folder = Nothing, _
Optional ByVal bCreate As Boolean = True _
) As MAPI.Folder

Dim CdoInfoStore As MAPI.InfoStore
Dim CdoFolderRoot As MAPI.Folder
Dim CdoFolders As MAPI.Folders
Dim CdoFolder As MAPI.Folder
Dim bFound As Boolean

' If the parent folder wasn't passed in, then use the root
' folder of the default InfoStore.

If CdoFolderParent Is Nothing Then
' Get the Folders collection from the default InfoStore.
Set CdoInfoStore = CdoSession.GetInfoStore
Set CdoFolderRoot = CdoInfoStore.RootFolder
Set CdoFolders = CdoFolderRoot.Folders
Else
' Get the Folders collection from the parent folder.
Set CdoFolders = CdoFolderParent.Folders
End If

' Loop through the folders in the collection until the
' desired folder is found.
bFound = False
Set CdoFolder = CdoFolders.GetFirst
Do While (Not bFound) And Not (CdoFolder Is Nothing)
If CdoFolder.Name = strFolderName Then
bFound = True
Else
Set CdoFolder = CdoFolders.GetNext
End If
Loop

' If not found, then create it (if caller said to).
If (CdoFolder Is Nothing) And bCreate Then
Set CdoFolder = CdoFolders.Add(strFolderName)
End If

Set GetFolderByName = CdoFolder

' Release our local objects.
Set CdoFolder = Nothing
Set CdoFolders = Nothing
Set CdoFolderRoot = Nothing
Set CdoInfoStore = Nothing

End Function ' GetFolderByName




Does not show Hidden Folders!!

Search Folders and VBA
 

After 4 days of searching!!!

Here is the function that gets the emtryid:


Function FindSearchFolder(MySession As Session, MyStore As String,
myFolder As String)
Dim cdo As MAPI.Session
Dim store As MAPI.InfoStore
Dim sfld As MAPI.Folder
Dim fld As MAPI.Folder
Dim f As MAPI.Field
Dim strFinderID As String
Dim strList As String
Dim count As Integer
Const PR_FINDER_ENTRYID = &H35E70102
Const PR_IPM_PUBLIC_FOLDERS_ENTRYID = &H66310102
Dim blnMayHaveSearches As Boolean

On Error Resume Next

Set cdo = CreateObject("MAPI.Session")
cdo.Logon "", "", False, False

Set store = cdo.GetInfoStore(MyStore)
strFolderName = UCase(myFolder)
blnMayHaveSearches = True

' ignore if it's the Public Folders hierarchy
' don't have search folders in Public Folders
If store.ProviderName = "Microsoft Exchange Server" Then
Set f = store.Fields.Item(PR_IPM_PUBLIC_FOLDERS_ENTRYID)
If Not f Is Nothing Then
blnMayHaveSearches = False
End If
Set f = Nothing
End If

If blnMayHaveSearches Then
strFinderID = _
store.Fields.Item(PR_FINDER_ENTRYID).Value
Set sfld = cdo.GetFolder(strFinderID, store.ID)
If Not sfld Is Nothing Then
count = sfld.Folders.count
If count 0 Then
strList = strList & vbCrLf & store.Name & " has " &
_
CStr(count) & " search " & _
IIf(count = 1, "folder:", "folders:")
For Each fld In sfld.Folders
If fld.Name = myFolder Then
FindSearchFolder = fld.ID

Exit Function
End If
Next
strList = strList & vbCrLf
End If
End If

End If

If Len(strList) 2 Then
strList = Mid(strList, 3)
FindSearchFolder = Null
Else
MsgBox "No search folders found"
FindSearchFolder = Null

End If

cdo.Logoff
Set cdo = Nothing
Set store = Nothing
Set fld = Nothing
Set sfld = Nothing
End Function