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