search folders

[Lp12]

hi all,

I'm tring to create a search folder with VBA code. my code creates one but
when i check it after (right click on the SF>cutsomize this SF) the criteria
button is disabled and non of the items are in the folder.
Here is the code:

Sub CreateSearchFolder()
Dim mpfRoot As Outlook.MAPIFolder
Dim mpf As Outlook.MAPIFolder
Dim idx As Integer
Dim Fileidx As Integer
Dim Subjectname As String
Dim SubjectnameFolder As MAPIFolder
Dim Subjectnamepoz As Long
Dim obj As Object
Dim MyItem As Outlook.MailItem
Dim CopyItem As Outlook.MailItem
Const strS1 As String = "Inbox"
Dim objSch As Search
Dim strF1 As String
Dim objSearchFolder As Outlook.MAPIFolder

Set mpf = Application.Session.GetDefaultFolder(olFolderInbox)
Set mpfRoot = mpf.Parent

'External loop for each mail item in Inbox
For Fileidx = 1 To mpf.Items.Count
Set obj = mpf.Items(Fileidx)
' Check the item´s type
If TypeOf obj Is Outlook.MailItem Then
Set MyItem = obj
Set CopyItem = MyItem
Subjectname = CopyItem.Subject
Subjectnamepoz = InStr(1, Subjectname, " ")
Subjectname = Left(Subjectname, Subjectnamepoz - 1)
strF1 = "urn:schemas:mailheader:subject = '" & Subjectname & " '"

' Check for the folder in a separate function
Set SubjectnameFolder = CheckForFolder(mpfRoot.Folders, Subjectname)
If SubjectnameFolder Is Nothing Then
' Folder doesn´t exist. Create first then move item into it.
Set objSch = Application.AdvancedSearch(Scope:=strS1,
Filter:=strF1, SearchSubFolders:=True, Tag:=Subjectname)
Set objSearchFolder = objSch.Save(Subjectname)
MyItem.FlagStatus = OlFlagStatus.olFlagMarked
MyItem.FlagIcon = olBlueFlagIcon
MyItem.Save
MsgBox objSearchFolder.Items.Count

Else
Set objSch = Application.AdvancedSearch(Scope:=strS1,
Filter:=strF1, SearchSubFolders:=True, Tag:=Subjectname)
MyItem.FlagStatus = olFlagMarked
MyItem.FlagIcon = olBlueFlagIcon
MyItem.Save
End If
End If
Next
End Sub

Private Function CheckForFolder(colFolders As Outlook.Folders, sName As
String) As Outlook.MAPIFolder
Dim idx As Integer
On Error Resume Next
For idx = 1 To colFolders.Count
If colFolders.Item(idx).Name = sName Then
Set CheckForFolder = colFolders(sName)
Exit For
End If
Next
End Function