Outlook macro when run gets all the PST's Followup into the favorites box.

Hi,

Outlook macro when run gets all the PST's Followup into the favorites box.
I need this code so i can use them for many systems. When run get the followup of each pst into the favorites box and remove anything else there.

REgards
Sharath
LVL 11
bsharathAsked:
Who is Participating?
 
David LeeCommented:
Try this.
Private Sub MakeMySearchFolders()
    Dim olkStores As Outlook.Stores, _
        olkStore As Outlook.Store, _
        olkSrchFolders As Outlook.Folders, _
        olkSrchFolder As Outlook.Folder, _
        olkFolder As Outlook.Folder, _
        strFolderList As Variant, _
        olkSearch As Outlook.Search, _
        objFSO As Object, _
        objFile As Object
    On Error Resume Next
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'Change the file name and path on the next line'
    Set objFile = objFSO.CreateTextFile("C:\eeTesting\MakeMySearchFoldersLog.txt")
    Set olkStores = Outlook.Session.Stores
    For Each olkStore In olkStores
        objFile.WriteLine "[" & Now & "] Processing store " & olkStore.DisplayName
        strFolderList = ""
        Set olkSrchFolders = olkStore.GetSearchFolders
        objFile.WriteLine "[" & Now & "] olkSrchFolders = " & TypeName(olkSrchFolders)
        objFile.WriteLine "[" & Now & "] Checking for 'For Follow Up'"
        Set olkSrchFolder = olkSrchFolders.Item("For Follow Up")
        objFile.WriteLine "[" & Now & "] olkSrchFolder = " & TypeName(olkSrchFolder)
        If TypeName(olkSrchFolder) = "Nothing" Then
            objFile.WriteLine "[" & Now & "] Building folder list"
            For Each olkFolder In olkStore.GetRootFolder.Folders
                strFolderList = strFolderList & "'" & olkFolder.FolderPath & "',"
            Next
            strFolderList = Left(strFolderList, Len(strFolderList) - 1)
            objFile.WriteLine "[" & Now & "] strFolderlist = " & Len(strFolderList)
            Set olkSearch = Application.AdvancedSearch(strFolderList, "(""urn:schemas:httpmail:messageflag"" = 'Follow up' AND ""http://schemas.microsoft.com/mapi/proptag/0x10910040"" IS NULL)", True, "For Follow Up")
            objFile.WriteLine "[" & Now & "] olkSearch = " & TypeName(olkSearch)
            olkSearch.Save "For Follow Up"
            Set olkSrchFolder = olkSrchFolders.Item("For Follow Up")
            olkSrchFolder.ShowItemCount = olShowTotalItemCount
            AddFavoriteFolder olkSrchFolder
        Else
            objFile.WriteLine "[" & Now & "] Folder 'For Follow Up' already exists"
            AddFavoriteFolder olkSrchFolder
        End If
        Set olkSrchFolder = Nothing
        objFile.WriteLine "-----"
    Next
    On Error GoTo 0
    Set olkStores = Nothing
    Set olkStore = Nothing
    Set olkSrchFolders = Nothing
    Set olkSrchFolder = Nothing
    objFile.Close
    Set objFile = Nothing
    Set objFSO = Nothing
    MsgBox "Done"
End Sub

Open in new window

0
 
peakpeakCommented:
Script code examples to build from here:
http://www.outlookcode.com (download Sues Code examples)
http://www.slovaktech.com/code_samples.htm
0
 
David LeeCommented:
Hi, Sharath.

Sorry, I don't understand the question.  What is a "PST's Followup"?  I've never heard that term before.
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

 
bsharathAuthor Commented:
David what i mean is in each pst or mailbox when we go to the search folders

Search folders
> Categorized mails
>> for follow up.
Thats is waht i want to add it to the favorites so all are visible in the top most in the left hand side
0
 
bsharathAuthor Commented:
David what i mean is in each pst or mailbox when we go to the search folders

Search folders
> Categorized mails
>> for follow up.
Thats is waht i want to add it to the favorites so all are visible in the top most in the left hand side
0
 
David LeeCommented:
I want to be certain that I understand the question.  Are you saying that you want to add a two search folders (one for categorized mails and another for follow-up emails) to each PST in your folder list?
0
 
bsharathAuthor Commented:
David
In search folder we have some thing as Followup
So all the mails those are flagged in any folder in that pst can be see in one place
As shown in the image are some of my pst's flagged folders.
0
 
bsharathAuthor Commented:
David
In search folder we have some thing as Followup
So all the mails those are flagged in any folder in that pst can be see in one place
As shown in the image are some of my pst's flagged folders.

Capture12.JPG
0
 
David LeeCommented:
So you want this same set of search folders created in each PST.  Is that correct?
0
 
bsharathAuthor Commented:
Yes created and if not there and added as favorites as in the screenshot. if not available. If its already there then do nothing
0
 
bsharathAuthor Commented:
Yes created and if not there and added as favorites as in the screenshot. if not available. If its already there then do nothing
0
 
David LeeCommented:
You'll have to provide the conditions those queries are based on for me to be able to duplicate them.
0
 
bsharathAuthor Commented:
Attached are 2 screenshots. The followup is what i want in this case. As we can created multiple follow up's if required for 1 pst. So i want it to check if available do nothing else add and add to favorites

Capture14.JPG
Capture15.JPG
0
 
David LeeCommented:
That's one.  What about the other five or six?
0
 
bsharathAuthor Commented:
You mean you need the pst names.
I have 6 psts. I need the same thing to be done for all 6 pst's and mailbox
0
 
David LeeCommented:
No, I don't need the pst names.  The screenshot you uploaded in post 24176007 shows six search folders.  I asked, "So you want this same set of search folders created in each PST.  Is that correct?" and you said "Yes".  That means a solution needs to create those six folders.  I need the condition that each one uses to be able to create them.  You posted the condition for one folder.  I need the conditions for the other five.
0
 
bsharathAuthor Commented:
No
one followup for one pst.
That image was for my 6 pst's


0
 
bsharathAuthor Commented:
No
one followup for one pst.
That image was for my 6 pst's


0
 
bsharathAuthor Commented:
Hi David any help on this...
0
 
David LeeCommented:
Sharath,

I have finished the code for this.  What folder or folders should the search folder apply to?
0
 
bsharathAuthor Commented:
Its the "Mails Flagged for followup"

I want this folder to be added in the favorites
0
 
David LeeCommented:
I understand that.  What folder or folders do you want the search folder to run against?
0
 
bsharathAuthor Commented:
All folders within each of the pst
All even sent folder if it has a flag them should show it
0
 
David LeeCommented:
Here's the code for doing this.  Follow these instructions to use it.

1.  Start Outlook
2.  Click Tools > Macro > Visual Basic Editor
3.  If not already expanded, expand Microsoft Office Outlook Objects
4.  If not already expanded, expand Modules
5.  Select an existing module (e.g. Module1) by double-clicking on it or create a new module by right-clicking Modules and selecting Insert > Module.
6.  Copy the code from the Code Snippet box and paste it into the right-hand pane of Outlook's VB Editor window
7.  Edit the code as needed.  I included comments wherever something needs to or can change
8.  Click the diskette icon on the toolbar to save the changes
9.  Close the VB Editor
10. Run the macro

Warning: Although I don't see it documented anywhere there's a limit on the length of the character string containing the names of the folders that the search filter applies to.  If that limit is exceeded, then no search folders will be created for that PST file.
Private Sub MakeMySearchFolders()
    Dim olkStores As Outlook.Stores, _
        olkStore As Outlook.Store, _
        olkSrchFolders As Outlook.Folders, _
        olkSrchFolder As Outlook.Folder, _
        olkFolder As Outlook.Folder, _
        strFolderList As Variant, _
        olkSearch As Outlook.Search
    On Error Resume Next
    Set olkStores = Outlook.Session.Stores
    For Each olkStore In olkStores
        strFolderList = ""
        Set olkSrchFolders = olkStore.GetSearchFolders
        Set olkSrchFolder = olkSrchFolders.Item("Categorized Mail")
        If TypeName(olkSrchFolder) = "Nothing" Then
            For Each olkFolder In olkStore.GetRootFolder.Folders
                strFolderList = strFolderList & "'" & olkFolder.FolderPath & "',"
            Next
            strFolderList = Left(strFolderList, Len(strFolderList) - 1)
            Debug.Print Len(strFolderList)
            Set olkSearch = Application.AdvancedSearch(strFolderList, "NOT(""urn:schemas-microsoft-com:office:office#Keywords"" IS NULL)", True, "Categorized Mail")
            olkSearch.Save "Categorized Mail"
            Set olkSrchFolder = olkSrchFolders.Item("Categorized Mail")
            AddFavoriteFolder olkSrchFolder
        End If
        Set olkSrchFolder = Nothing
        Set olkSrchFolder = olkSrchFolders.Item("For Follow Up")
        If TypeName(olkSrchFolder) = "Nothing" Then
            Set olkSearch = Application.AdvancedSearch(strFolderList, "NOT(""urn:schemas:httpmail:messageflag"" IS NULL)", True, "For Follow Up")
            olkSearch.Save "For Follow Up"
            Set olkSrchFolder = olkSrchFolders.Item("For Follow Up")
            AddFavoriteFolder olkSrchFolder
        End If
        Set olkSrchFolder = Nothing
    Next
    On Error GoTo 0
    Set olkStores = Nothing
    Set olkStore = Nothing
    Set olkSrchFolders = Nothing
    Set olkSrchFolder = Nothing
    MsgBox "Done"
End Sub
 
Private Sub AddFavoriteFolder(olkFolder As Outlook.Folder)
    ' Purpose: Add a folder to Favorite Folders.'
    ' Written: 5/2/2009'
    ' Author:  BlueDevilFan'
    ' Outlook: 2007'
    Dim olkPane As Object, _
        olkModule As Object, _
        olkGroup As Object
    Set olkPane = Outlook.Application.ActiveExplorer.NavigationPane
    Set olkModule = olkPane.Modules.GetNavigationModule(olModuleMail)
    Set olkGroup = olkModule.NavigationGroups.GetDefaultNavigationGroup(olFavoriteFoldersGroup)
    olkGroup.NavigationFolders.Add olkFolder
    Set olkPane = Nothing
    Set olkModule = Nothing
    Set olkGroup = Nothing
End Sub

Open in new window

0
 
bsharathAuthor Commented:
Thanks a lot David for remembering on this...
:-)

How do i run this code...
They dont show up
0
 
bsharathAuthor Commented:
Thanks a lot David for remembering on this...
:-)

How do i run this code...
They dont show up
0
 
David LeeCommented:
Run the routine named MakeMySearchFolders.  Are you saying that after adding it to Outlook that it doesn't show up in the list of macros?
0
 
bsharathAuthor Commented:
Yes David i cannot see this name
0
 
David LeeCommented:
Delete the word "Private" from this line.

    Private Sub MakeMySearchFolders()
0
 
bsharathAuthor Commented:
Ok got it

I ran the macro and get this in the immediate windo

 87
 66
 272
 85
 349
 49

But no change. I did not get the followup into favorites
0
 
bsharathAuthor Commented:
Ok got it

I ran the macro and get this in the immediate windo

 87
 66
 272
 85
 349
 49

But no change. I did not get the followup into favorites
0
 
David LeeCommented:
The numbers are being written by the debug statement on line 20 of MakeMySearchFolders.  You can delete it if you want to.  I meant to, but obviously forgot.  Forgetting about favotires for a minute, were the search folders created?
0
 
bsharathAuthor Commented:
No even the search folders were not created
0
 
bsharathAuthor Commented:
No even the search folders were not created
0
 
David LeeCommented:
Ok, replace MakeMySearchFolders with the version below.  I've added code to create a log file that may help me figure out why the code works perfectly for me but not for you.  Once you've replaced the code run it again, then post the log file here.  The log file will be named "MakeMySearchFoldersLog.txt" and will be in the root of your C: drive.
Sub MakeMySearchFolders()
    Dim olkStores As Outlook.Stores, _
        olkStore As Outlook.Store, _
        olkSrchFolders As Outlook.Folders, _
        olkSrchFolder As Outlook.Folder, _
        olkFolder As Outlook.Folder, _
        strFolderList As Variant, _
        olkSearch As Outlook.Search, _
        objFSO As Object, _
        objFile As Object
    On Error Resume Next
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.CreateTextFile("C:\MakeMySearchFoldersLog.txt")
    Set olkStores = Outlook.Session.Stores
    For Each olkStore In olkStores
        objFile.WriteLine "[" & Now & "] Processing store " & olkStore.DisplayName
        strFolderList = ""
        Set olkSrchFolders = olkStore.GetSearchFolders
        objFile.WriteLine "[" & Now & "] olkSrchFolders = " & TypeName(olkSrchFolders)
        objFile.WriteLine "[" & Now & "] Checking for 'Categorized Mail'"
        Set olkSrchFolder = olkSrchFolders.Item("Categorized Mail")
        objFile.WriteLine "[" & Now & "] olkSrchFolder = " & TypeName(olkSrchFolder)
        If TypeName(olkSrchFolder) = "Nothing" Then
            objFile.WriteLine "[" & Now & "] Building folder list"
            For Each olkFolder In olkStore.GetRootFolder.Folders
                strFolderList = strFolderList & "'" & olkFolder.FolderPath & "',"
            Next
            strFolderList = Left(strFolderList, Len(strFolderList) - 1)
            objFile.WriteLine "[" & Now & "] strFolderlist = " & Len(strFolderList)
            Set olkSearch = Application.AdvancedSearch(strFolderList, "NOT(""urn:schemas-microsoft-com:office:office#Keywords"" IS NULL)", True, "Categorized Mail")
            objFile.WriteLine "[" & Now & "] olkSearch = " & TypeName(olkSearch)
            olkSearch.Save "Categorized Mail"
            Set olkSrchFolder = olkSrchFolders.Item("Categorized Mail")
            AddFavoriteFolder olkSrchFolder
        Else
            objFile.WriteLine "[" & Now & "] Folder 'Categorized Mail' already exists"
        End If
        Set olkSrchFolder = Nothing
        objFile.WriteLine "[" & Now & "] Checking for 'For Follow Up'"
        Set olkSrchFolder = olkSrchFolders.Item("For Follow Up")
        objFile.WriteLine "[" & Now & "] olkSrchFolder = " & TypeName(olkSrchFolder)
        If TypeName(olkSrchFolder) = "Nothing" Then
            Set olkSearch = Application.AdvancedSearch(strFolderList, "NOT(""urn:schemas:httpmail:messageflag"" IS NULL)", True, "For Follow Up")
            objFile.WriteLine "[" & Now & "] olkSearch = " & TypeName(olkSearch)
            olkSearch.Save "For Follow Up"
            Set olkSrchFolder = olkSrchFolders.Item("For Follow Up")
            AddFavoriteFolder olkSrchFolder
        Else
            objFile.WriteLine "[" & Now & "] Folder 'For Follow Up' already exists"
        End If
        Set olkSrchFolder = Nothing
        objFile.WriteLine "-----"
    Next
    On Error GoTo 0
    Set olkStores = Nothing
    Set olkStore = Nothing
    Set olkSrchFolders = Nothing
    Set olkSrchFolder = Nothing
    objFile.Close
    Set objFile = Nothing
    Set objFSO = Nothing
    MsgBox "Done"
End Sub

Open in new window

0
 
bsharathAuthor Commented:
David...

I get them now

Whicle testing i removed the 'follwup' and left 'Categorized Mail'
thats the reason it did not create.

Now it removed the 'Categorized Mail' and when run it does create

both
'Categorized Mail'
'follwup'

Now adding the follwup to the favorites is left
0
 
bsharathAuthor Commented:
David...

I get them now

Whicle testing i removed the 'follwup' and left 'Categorized Mail'
thats the reason it did not create.

Now it removed the 'Categorized Mail' and when run it does create

both
'Categorized Mail'
'follwup'

Now adding the follwup to the favorites is left
0
 
David LeeCommented:
But none of them show up in the favorites?  Unbelievable.  Sorry, but I have to ask if you're looking in the right place for the favorites.  The code there is so simple that I cannot believe it's failing.  
0
 
bsharathAuthor Commented:
Attached is the image.You can see that the followup does not get into the favorites place..
:-(

Captur-e.JPG
0
 
David LeeCommented:
Is the subroutine AddFavoriteFolder still there, or did you delete it when you replaced the other subroutine?
0
 
bsharathAuthor Commented:
This code is stll there
Private Sub AddFavoriteFolder(olkFolder As Outlook.Folder)
    ' Purpose: Add a folder to Favorite Folders.'
    ' Written: 5/2/2009'
    ' Author:  BlueDevilFan'
    ' Outlook: 2007'
    Dim olkPane As Object, _
        olkModule As Object, _
        olkGroup As Object
    Set olkPane = Outlook.Application.ActiveExplorer.NavigationPane
    Set olkModule = olkPane.Modules.GetNavigationModule(olModuleMail)
    Set olkGroup = olkModule.NavigationGroups.GetDefaultNavigationGroup(olFavoriteFoldersGroup)
    olkGroup.NavigationFolders.Add olkFolder
    Set olkPane = Nothing
    Set olkModule = Nothing
    Set olkGroup = Nothing
End Sub

Open in new window

0
 
bsharathAuthor Commented:
And even when i go into the followup folder i can see the ticked followup's also shown.

I want just the followup mails that are checked with red
Not the completed followup's

Thanks
0
 
bsharathAuthor Commented:
And even when i go into the followup folder i can see the ticked followup's also shown.

I want just the followup mails that are checked with red
Not the completed followup's

Thanks
0
 
David LeeCommented:
Try removing Private from this line

Private Sub AddFavoriteFolder(olkFolder As Outlook.Folder)

and run again.  You'll have to delete all the search folders before re-running.
0
 
bsharathAuthor Commented:
The folders get created as

Categorized Mail
For Follow Up

But they dont get into the Favorites
0
 
bsharathAuthor Commented:
The folders get created as

Categorized Mail
For Follow Up

But they dont get into the Favorites
0
 
David LeeCommented:
Replace AddFavoriteFoldeer with the version below, then delete the search folders and run this again.  Let me know if you get a message pop-up for each folder.
Sub AddFavoriteFolder(olkFolder As Outlook.Folder)
    ' Purpose: Add a folder to Favorite Folders.'
    ' Written: 5/2/2009'
    ' Author:  BlueDevilFan'
    ' Outlook: 2007'
    Dim olkPane As Object, _
        olkModule As Object, _
        olkGroup As Object
    MsgBox "Adding " & olkFolder.Name & " to favorites"
    Set olkPane = Outlook.Application.ActiveExplorer.NavigationPane
    Set olkModule = olkPane.Modules.GetNavigationModule(olModuleMail)
    Set olkGroup = olkModule.NavigationGroups.GetDefaultNavigationGroup(olFavoriteFoldersGroup)
    olkGroup.NavigationFolders.Add olkFolder
    Set olkPane = Nothing
    Set olkModule = Nothing
    Set olkGroup = Nothing
End Sub

Open in new window

0
 
bsharathAuthor Commented:
Still does not create David.

Below is the log that gets created
[5/7/2009 5:50:30 PM] Processing store Mailbox - Sharath
[5/7/2009 5:50:30 PM] olkSrchFolders = Folders
[5/7/2009 5:50:30 PM] Checking for 'Categorized Mail'
[5/7/2009 5:50:30 PM] olkSrchFolder = Nothing
[5/7/2009 5:50:30 PM] Building folder list
[5/7/2009 5:50:30 PM] strFolderlist = 593
[5/7/2009 5:50:30 PM] olkSearch = Search
[5/7/2009 5:50:30 PM] Checking for 'For Follow Up'
[5/7/2009 5:50:30 PM] olkSrchFolder = Nothing
[5/7/2009 5:50:30 PM] olkSearch = Search
-----
[5/7/2009 5:50:30 PM] Processing store Sent
[5/7/2009 5:50:30 PM] olkSrchFolders = Folders
[5/7/2009 5:50:30 PM] Checking for 'Categorized Mail'
[5/7/2009 5:50:30 PM] olkSrchFolder = Nothing
[5/7/2009 5:50:30 PM] Building folder list
[5/7/2009 5:50:30 PM] strFolderlist = 87
[5/7/2009 5:50:36 PM] olkSearch = Search
[5/7/2009 5:50:37 PM] Checking for 'For Follow Up'
[5/7/2009 5:50:37 PM] olkSrchFolder = Nothing
[5/7/2009 5:50:38 PM] olkSearch = Search
-----
[5/7/2009 5:50:39 PM] Processing store Public Folders
[5/7/2009 5:50:39 PM] olkSrchFolders = Folders
[5/7/2009 5:50:39 PM] Checking for 'Categorized Mail'
[5/7/2009 5:50:39 PM] olkSrchFolder = MAPIFolder
[5/7/2009 5:50:39 PM] Folder 'Categorized Mail' already exists
[5/7/2009 5:50:39 PM] Checking for 'For Follow Up'
[5/7/2009 5:50:39 PM] olkSrchFolder = Nothing
[5/7/2009 5:50:39 PM] olkSearch = Search
-----
[5/7/2009 5:50:39 PM] Processing store All Mails
[5/7/2009 5:50:39 PM] olkSrchFolders = Folders
[5/7/2009 5:50:39 PM] Checking for 'Categorized Mail'
[5/7/2009 5:50:39 PM] olkSrchFolder = Nothing
[5/7/2009 5:50:39 PM] Building folder list
[5/7/2009 5:50:39 PM] strFolderlist = 272
[5/7/2009 5:50:42 PM] olkSearch = Search
[5/7/2009 5:50:43 PM] Checking for 'For Follow Up'
[5/7/2009 5:50:43 PM] olkSrchFolder = Nothing
[5/7/2009 5:50:43 PM] olkSearch = Search
-----
[5/7/2009 5:50:43 PM] Processing store Jan2009
[5/7/2009 5:50:43 PM] olkSrchFolders = Folders
[5/7/2009 5:50:43 PM] Checking for 'Categorized Mail'
[5/7/2009 5:50:43 PM] olkSrchFolder = Nothing
[5/7/2009 5:50:43 PM] Building folder list
[5/7/2009 5:50:43 PM] strFolderlist = 85
[5/7/2009 5:50:44 PM] olkSearch = Search
[5/7/2009 5:50:44 PM] Checking for 'For Follow Up'
[5/7/2009 5:50:44 PM] olkSrchFolder = Nothing
[5/7/2009 5:50:45 PM] olkSearch = Search
-----
[5/7/2009 5:50:45 PM] Processing store Latest Mails
[5/7/2009 5:50:45 PM] olkSrchFolders = Folders
[5/7/2009 5:50:45 PM] Checking for 'Categorized Mail'
[5/7/2009 5:50:45 PM] olkSrchFolder = Nothing
[5/7/2009 5:50:45 PM] Building folder list
[5/7/2009 5:50:45 PM] strFolderlist = 349
[5/7/2009 5:50:57 PM] olkSearch = Search
[5/7/2009 5:50:57 PM] Checking for 'For Follow Up'
[5/7/2009 5:50:57 PM] olkSrchFolder = Nothing
[5/7/2009 5:50:58 PM] olkSearch = Search
-----
[5/7/2009 5:50:58 PM] Processing store Team Mails
[5/7/2009 5:50:58 PM] olkSrchFolders = Folders
[5/7/2009 5:50:58 PM] Checking for 'Categorized Mail'
[5/7/2009 5:50:58 PM] olkSrchFolder = Nothing
[5/7/2009 5:50:58 PM] Building folder list
[5/7/2009 5:50:58 PM] strFolderlist = 49
[5/7/2009 5:50:59 PM] olkSearch = Search
[5/7/2009 5:51:00 PM] Checking for 'For Follow Up'
[5/7/2009 5:51:00 PM] olkSrchFolder = Nothing
[5/7/2009 5:51:00 PM] olkSearch = Search
-----

Open in new window

0
 
David LeeCommented:
Did you get any pop-up messages?
0
 
bsharathAuthor Commented:
I get the Done box thats it
0
 
bsharathAuthor Commented:
I get the Done box thats it
0
 
David LeeCommented:
Then the code for adding favorites isn't running at all.  Do you have two subroutines named AddFavoriteFolder?  Please check and see.
0
 
bsharathAuthor Commented:
AddFavoriteFolder

Is only in the below code in 3 places no where else...
Sub MakeMySearchFolders()
    Dim olkStores As Outlook.Stores, _
        olkStore As Outlook.Store, _
        olkSrchFolders As Outlook.Folders, _
        olkSrchFolder As Outlook.Folder, _
        olkFolder As Outlook.Folder, _
        strFolderList As Variant, _
        olkSearch As Outlook.Search, _
        objFSO As Object, _
        objFile As Object
    On Error Resume Next
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.CreateTextFile("C:\MakeMySearchFoldersLog.txt")
    Set olkStores = Outlook.Session.Stores
    For Each olkStore In olkStores
        objFile.WriteLine "[" & Now & "] Processing store " & olkStore.DisplayName
        strFolderList = ""
        Set olkSrchFolders = olkStore.GetSearchFolders
        objFile.WriteLine "[" & Now & "] olkSrchFolders = " & TypeName(olkSrchFolders)
        objFile.WriteLine "[" & Now & "] Checking for 'Categorized Mail'"
        Set olkSrchFolder = olkSrchFolders.Item("Categorized Mail")
        objFile.WriteLine "[" & Now & "] olkSrchFolder = " & TypeName(olkSrchFolder)
        If TypeName(olkSrchFolder) = "Nothing" Then
            objFile.WriteLine "[" & Now & "] Building folder list"
            For Each olkFolder In olkStore.GetRootFolder.Folders
                strFolderList = strFolderList & "'" & olkFolder.folderPath & "',"
            Next
            strFolderList = Left(strFolderList, Len(strFolderList) - 1)
            objFile.WriteLine "[" & Now & "] strFolderlist = " & Len(strFolderList)
            Set olkSearch = Application.AdvancedSearch(strFolderList, "NOT(""urn:schemas-microsoft-com:office:office#Keywords"" IS NULL)", True, "Categorized Mail")
            objFile.WriteLine "[" & Now & "] olkSearch = " & TypeName(olkSearch)
            olkSearch.Save "Categorized Mail"
            Set olkSrchFolder = olkSrchFolders.Item("Categorized Mail")
            AddFavoriteFolder olkSrchFolder
        Else
            objFile.WriteLine "[" & Now & "] Folder 'Categorized Mail' already exists"
        End If
        Set olkSrchFolder = Nothing
        objFile.WriteLine "[" & Now & "] Checking for 'For Follow Up'"
        Set olkSrchFolder = olkSrchFolders.Item("For Follow Up")
        objFile.WriteLine "[" & Now & "] olkSrchFolder = " & TypeName(olkSrchFolder)
        If TypeName(olkSrchFolder) = "Nothing" Then
            Set olkSearch = Application.AdvancedSearch(strFolderList, "NOT(""urn:schemas:httpmail:messageflag"" IS NULL)", True, "For Follow Up")
            objFile.WriteLine "[" & Now & "] olkSearch = " & TypeName(olkSearch)
            olkSearch.Save "For Follow Up"
            Set olkSrchFolder = olkSrchFolders.Item("For Follow Up")
            AddFavoriteFolder olkSrchFolder
        Else
            objFile.WriteLine "[" & Now & "] Folder 'For Follow Up' already exists"
        End If
        Set olkSrchFolder = Nothing
        objFile.WriteLine "-----"
    Next
    On Error GoTo 0
    Set olkStores = Nothing
    Set olkStore = Nothing
    Set olkSrchFolders = Nothing
    Set olkSrchFolder = Nothing
    objFile.Close
    Set objFile = Nothing
    Set objFSO = Nothing
    MsgBox "Done"
End Sub
 
Sub AddFavoriteFolder(olkFolder As Outlook.Folder)
    ' Purpose: Add a folder to Favorite Folders.'
    ' Written: 5/2/2009'
    ' Author:  BlueDevilFan'
    ' Outlook: 2007'
    Dim olkPane As Object, _
        olkModule As Object, _
        olkGroup As Object
    MsgBox "Adding " & olkFolder.Name & " to favorites"
    Set olkPane = Outlook.Application.ActiveExplorer.NavigationPane
    Set olkModule = olkPane.Modules.GetNavigationModule(olModuleMail)
    Set olkGroup = olkModule.NavigationGroups.GetDefaultNavigationGroup(olFavoriteFoldersGroup)
    olkGroup.NavigationFolders.Add olkFolder
    Set olkPane = Nothing
    Set olkModule = Nothing
    Set olkGroup = Nothing
End Sub
 

Open in new window

0
 
bsharathAuthor Commented:
AddFavoriteFolder

Is only in the below code in 3 places no where else...
Sub MakeMySearchFolders()
    Dim olkStores As Outlook.Stores, _
        olkStore As Outlook.Store, _
        olkSrchFolders As Outlook.Folders, _
        olkSrchFolder As Outlook.Folder, _
        olkFolder As Outlook.Folder, _
        strFolderList As Variant, _
        olkSearch As Outlook.Search, _
        objFSO As Object, _
        objFile As Object
    On Error Resume Next
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.CreateTextFile("C:\MakeMySearchFoldersLog.txt")
    Set olkStores = Outlook.Session.Stores
    For Each olkStore In olkStores
        objFile.WriteLine "[" & Now & "] Processing store " & olkStore.DisplayName
        strFolderList = ""
        Set olkSrchFolders = olkStore.GetSearchFolders
        objFile.WriteLine "[" & Now & "] olkSrchFolders = " & TypeName(olkSrchFolders)
        objFile.WriteLine "[" & Now & "] Checking for 'Categorized Mail'"
        Set olkSrchFolder = olkSrchFolders.Item("Categorized Mail")
        objFile.WriteLine "[" & Now & "] olkSrchFolder = " & TypeName(olkSrchFolder)
        If TypeName(olkSrchFolder) = "Nothing" Then
            objFile.WriteLine "[" & Now & "] Building folder list"
            For Each olkFolder In olkStore.GetRootFolder.Folders
                strFolderList = strFolderList & "'" & olkFolder.folderPath & "',"
            Next
            strFolderList = Left(strFolderList, Len(strFolderList) - 1)
            objFile.WriteLine "[" & Now & "] strFolderlist = " & Len(strFolderList)
            Set olkSearch = Application.AdvancedSearch(strFolderList, "NOT(""urn:schemas-microsoft-com:office:office#Keywords"" IS NULL)", True, "Categorized Mail")
            objFile.WriteLine "[" & Now & "] olkSearch = " & TypeName(olkSearch)
            olkSearch.Save "Categorized Mail"
            Set olkSrchFolder = olkSrchFolders.Item("Categorized Mail")
            AddFavoriteFolder olkSrchFolder
        Else
            objFile.WriteLine "[" & Now & "] Folder 'Categorized Mail' already exists"
        End If
        Set olkSrchFolder = Nothing
        objFile.WriteLine "[" & Now & "] Checking for 'For Follow Up'"
        Set olkSrchFolder = olkSrchFolders.Item("For Follow Up")
        objFile.WriteLine "[" & Now & "] olkSrchFolder = " & TypeName(olkSrchFolder)
        If TypeName(olkSrchFolder) = "Nothing" Then
            Set olkSearch = Application.AdvancedSearch(strFolderList, "NOT(""urn:schemas:httpmail:messageflag"" IS NULL)", True, "For Follow Up")
            objFile.WriteLine "[" & Now & "] olkSearch = " & TypeName(olkSearch)
            olkSearch.Save "For Follow Up"
            Set olkSrchFolder = olkSrchFolders.Item("For Follow Up")
            AddFavoriteFolder olkSrchFolder
        Else
            objFile.WriteLine "[" & Now & "] Folder 'For Follow Up' already exists"
        End If
        Set olkSrchFolder = Nothing
        objFile.WriteLine "-----"
    Next
    On Error GoTo 0
    Set olkStores = Nothing
    Set olkStore = Nothing
    Set olkSrchFolders = Nothing
    Set olkSrchFolder = Nothing
    objFile.Close
    Set objFile = Nothing
    Set objFSO = Nothing
    MsgBox "Done"
End Sub
 
Sub AddFavoriteFolder(olkFolder As Outlook.Folder)
    ' Purpose: Add a folder to Favorite Folders.'
    ' Written: 5/2/2009'
    ' Author:  BlueDevilFan'
    ' Outlook: 2007'
    Dim olkPane As Object, _
        olkModule As Object, _
        olkGroup As Object
    MsgBox "Adding " & olkFolder.Name & " to favorites"
    Set olkPane = Outlook.Application.ActiveExplorer.NavigationPane
    Set olkModule = olkPane.Modules.GetNavigationModule(olModuleMail)
    Set olkGroup = olkModule.NavigationGroups.GetDefaultNavigationGroup(olFavoriteFoldersGroup)
    olkGroup.NavigationFolders.Add olkFolder
    Set olkPane = Nothing
    Set olkModule = Nothing
    Set olkGroup = Nothing
End Sub
 

Open in new window

0
 
David LeeCommented:
Then I can't explain what's happening.  The main routine is calling AddFavoriteFolder and I have a line of code in AddFavoriteFolder to display a pop up message each time it runs.  That popup is never appearing, which means the code is not firing.  If the AddFavoriteFolder is there and there are no other procedures with the same name, then it's pretty much impossible for it not to run.  
0
 
bsharathAuthor Commented:
:-(
Is there any way to run this routine only
Sub AddFavoriteFolder(olkFolder As Outlook.Folder)
So i can try running this seperately to see whats happening
0
 
David LeeCommented:
Sure.  Add the code below to the same module the code above is in.  Select a folder and try running it.  It will attempt to add the selected folder as a favorite.
Sub TestAddingFavorite()
    AddFavoriteFolder Outlook.Application.ActiveExplorer.CurrentFolder
End Sub

Open in new window

0
 
bsharathAuthor Commented:
Yes this does work
But in the folder follow up i can see all follow up mails which are completed too. Can i get just that are flagged
0
 
David LeeCommented:
Yes, I'll adjust the other code.  Just trying to fix one issue at a time.  :-)
0
 
David LeeCommented:
Replace the sub MakeMySearchFolders with the version below.
Private Sub MakeMySearchFolders()
    Dim olkStores As Outlook.Stores, _
        olkStore As Outlook.Store, _
        olkSrchFolders As Outlook.Folders, _
        olkSrchFolder As Outlook.Folder, _
        olkFolder As Outlook.Folder, _
        strFolderList As Variant, _
        olkSearch As Outlook.Search, _
        objFSO As FileSystemObject, _
        objFile As TextStream
    On Error Resume Next
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.CreateTextFile("C:\eeTesting\MakeMySearchFoldersLog.txt")
    Set olkStores = Outlook.Session.Stores
    For Each olkStore In olkStores
        objFile.WriteLine "[" & Now & "] Processing store " & olkStore.DisplayName
        strFolderList = ""
        Set olkSrchFolders = olkStore.GetSearchFolders
        objFile.WriteLine "[" & Now & "] olkSrchFolders = " & TypeName(olkSrchFolders)
        objFile.WriteLine "[" & Now & "] Checking for 'Categorized Mail'"
        Set olkSrchFolder = olkSrchFolders.Item("Categorized Mail")
        objFile.WriteLine "[" & Now & "] olkSrchFolder = " & TypeName(olkSrchFolder)
        If TypeName(olkSrchFolder) = "Nothing" Then
            objFile.WriteLine "[" & Now & "] Building folder list"
            For Each olkFolder In olkStore.GetRootFolder.Folders
                strFolderList = strFolderList & "'" & olkFolder.FolderPath & "',"
            Next
            strFolderList = Left(strFolderList, Len(strFolderList) - 1)
            objFile.WriteLine "[" & Now & "] strFolderlist = " & Len(strFolderList)
            Set olkSearch = Application.AdvancedSearch(strFolderList, "NOT(""urn:schemas-microsoft-com:office:office#Keywords"" IS NULL)", True, "Categorized Mail")
            objFile.WriteLine "[" & Now & "] olkSearch = " & TypeName(olkSearch)
            olkSearch.Save "Categorized Mail"
            Set olkSrchFolder = olkSrchFolders.Item("Categorized Mail")
            AddFavoriteFolder olkSrchFolder
        Else
            objFile.WriteLine "[" & Now & "] Folder 'Categorized Mail' already exists"
        End If
        Set olkSrchFolder = Nothing
        objFile.WriteLine "[" & Now & "] Checking for 'For Follow Up'"
        Set olkSrchFolder = olkSrchFolders.Item("For Follow Up")
        objFile.WriteLine "[" & Now & "] olkSrchFolder = " & TypeName(olkSrchFolder)
        If TypeName(olkSrchFolder) = "Nothing" Then
            Set olkSearch = Application.AdvancedSearch(strFolderList, "http://schemas.microsoft.com/mapi/proptag/0x10900003" = 2, True, "For Follow Up")
            objFile.WriteLine "[" & Now & "] olkSearch = " & TypeName(olkSearch)
            olkSearch.Save "For Follow Up"
            Set olkSrchFolder = olkSrchFolders.Item("For Follow Up")
            AddFavoriteFolder olkSrchFolder
        Else
            objFile.WriteLine "[" & Now & "] Folder 'For Follow Up' already exists"
        End If
        Set olkSrchFolder = Nothing
        objFile.WriteLine "-----"
    Next
    On Error GoTo 0
    Set olkStores = Nothing
    Set olkStore = Nothing
    Set olkSrchFolders = Nothing
    Set olkSrchFolder = Nothing
    objFile.Close
    Set objFile = Nothing
    Set objFSO = No

Open in new window

0
 
bsharathAuthor Commented:
Hi David.
I removed the Private and ran the macro and i gor Compile error and then i added an end sub to the end and it worked all fine...

As i mentioned i want just the followup to be created and added to favorites and not Categorized mails

Can i know which lines i can comment for that

2ndly i want the "Show no if items" radio button selected. So that i can see how many i have in the favorites that i need to followup

and i get can i get a way that if the folders are created then just add them to favories and if not then create the folders and add to favorites.

So if thay are there then just the adding to favorites would do....
0
 
bsharathAuthor Commented:
Hi David.
I removed the Private and ran the macro and i gor Compile error and then i added an end sub to the end and it worked all fine...

As i mentioned i want just the followup to be created and added to favorites and not Categorized mails

Can i know which lines i can comment for that

2ndly i want the "Show no if items" radio button selected. So that i can see how many i have in the favorites that i need to followup

and i get can i get a way that if the folders are created then just add them to favories and if not then create the folders and add to favorites.

So if thay are there then just the adding to favorites would do....
0
 
bsharathAuthor Commented:
Attached is the screenshot.

Where the followup does not show the flagged red ones but shows the unflagged and some other data. Dont know why...
0
 
bsharathAuthor Commented:
Attached is the screenshot.

Where the followup does not show the flagged red ones but shows the unflagged and some other data. Dont know why...
Captu.JPG
0
 
David LeeCommented:
"As i mentioned i want just the followup to be created and added to favorites and not Categorized mails"
Sorry, Categorized Mail was in the screeenshot, so I thought you wanted it too.  

Replace MakeMySearchFolder with the version below and try again.  Please remember to remove the existing search folders before running.
Private Sub MakeMySearchFolders()
    Dim olkStores As Outlook.Stores, _
        olkStore As Outlook.Store, _
        olkSrchFolders As Outlook.Folders, _
        olkSrchFolder As Outlook.Folder, _
        olkFolder As Outlook.Folder, _
        strFolderList As Variant, _
        olkSearch As Outlook.Search, _
        objFSO As Object, _
        objFile As Object
    On Error Resume Next
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'Change the file name and path on the next line'
    Set objFile = objFSO.CreateTextFile("C:\eeTesting\MakeMySearchFoldersLog.txt")
    Set olkStores = Outlook.Session.Stores
    For Each olkStore In olkStores
        objFile.WriteLine "[" & Now & "] Processing store " & olkStore.DisplayName
        strFolderList = ""
        Set olkSrchFolders = olkStore.GetSearchFolders
        objFile.WriteLine "[" & Now & "] olkSrchFolders = " & TypeName(olkSrchFolders)
        objFile.WriteLine "[" & Now & "] Checking for 'For Follow Up'"
        Set olkSrchFolder = olkSrchFolders.Item("For Follow Up")
        objFile.WriteLine "[" & Now & "] olkSrchFolder = " & TypeName(olkSrchFolder)
        If TypeName(olkSrchFolder) = "Nothing" Then
            objFile.WriteLine "[" & Now & "] Building folder list"
            For Each olkFolder In olkStore.GetRootFolder.Folders
                strFolderList = strFolderList & "'" & olkFolder.FolderPath & "',"
            Next
            strFolderList = Left(strFolderList, Len(strFolderList) - 1)
            objFile.WriteLine "[" & Now & "] strFolderlist = " & Len(strFolderList)
            Set olkSearch = Application.AdvancedSearch(strFolderList, """http://schemas.microsoft.com/mapi/proptag/0x10900003"" = 2", True, "For Follow Up")
            objFile.WriteLine "[" & Now & "] olkSearch = " & TypeName(olkSearch)
            olkSearch.Save "For Follow Up"
            Set olkSrchFolder = olkSrchFolders.Item("For Follow Up")
            AddFavoriteFolder olkSrchFolder
        Else
            objFile.WriteLine "[" & Now & "] Folder 'For Follow Up' already exists"
        End If
        Set olkSrchFolder = Nothing
        objFile.WriteLine "-----"
    Next
    On Error GoTo 0
    Set olkStores = Nothing
    Set olkStore = Nothing
    Set olkSrchFolders = Nothing
    Set olkSrchFolder = Nothing
    objFile.Close
    Set objFile = Nothing
    Set objFSO = Nothing
    MsgBox "Done"
End Sub

Open in new window

0
 
bsharathAuthor Commented:
All fine now except these 2 things

1. Need the folder to show no of mails within it. Just for the followup folders
2. I want just the red flagged mails to be shown in the followup. But i can see a different ones with a flag and a body image
0
 
David LeeCommented:
The code below addresses item #1.  I'm not sure if #2 is possible.  I'll check into it as soon as I can.
Private Sub MakeMySearchFolders()
    Dim olkStores As Outlook.Stores, _
        olkStore As Outlook.Store, _
        olkSrchFolders As Outlook.Folders, _
        olkSrchFolder As Outlook.Folder, _
        olkFolder As Outlook.Folder, _
        strFolderList As Variant, _
        olkSearch As Outlook.Search, _
        objFSO As Object, _
        objFile As Object
    On Error Resume Next
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'Change the file name and path on the next line'
    Set objFile = objFSO.CreateTextFile("C:\eeTesting\MakeMySearchFoldersLog.txt")
    Set olkStores = Outlook.Session.Stores
    For Each olkStore In olkStores
        objFile.WriteLine "[" & Now & "] Processing store " & olkStore.DisplayName
        strFolderList = ""
        Set olkSrchFolders = olkStore.GetSearchFolders
        objFile.WriteLine "[" & Now & "] olkSrchFolders = " & TypeName(olkSrchFolders)
        objFile.WriteLine "[" & Now & "] Checking for 'For Follow Up'"
        Set olkSrchFolder = olkSrchFolders.Item("For Follow Up")
        objFile.WriteLine "[" & Now & "] olkSrchFolder = " & TypeName(olkSrchFolder)
        If TypeName(olkSrchFolder) = "Nothing" Then
            objFile.WriteLine "[" & Now & "] Building folder list"
            For Each olkFolder In olkStore.GetRootFolder.Folders
                strFolderList = strFolderList & "'" & olkFolder.FolderPath & "',"
            Next
            strFolderList = Left(strFolderList, Len(strFolderList) - 1)
            objFile.WriteLine "[" & Now & "] strFolderlist = " & Len(strFolderList)
            Set olkSearch = Application.AdvancedSearch(strFolderList, """http://schemas.microsoft.com/mapi/proptag/0x10900003"" = 2", True, "For Follow Up")
            objFile.WriteLine "[" & Now & "] olkSearch = " & TypeName(olkSearch)
            olkSearch.Save "For Follow Up"
            Set olkSrchFolder = olkSrchFolders.Item("For Follow Up")
            olkSrchFolder.ShowItemCount = olShowTotalItemCount
            AddFavoriteFolder olkSrchFolder
        Else
            objFile.WriteLine "[" & Now & "] Folder 'For Follow Up' already exists"
        End If
        Set olkSrchFolder = Nothing
        objFile.WriteLine "-----"
    Next
    On Error GoTo 0
    Set olkStores = Nothing
    Set olkStore = Nothing
    Set olkSrchFolders = Nothing
    Set olkSrchFolder = Nothing
    objFile.Close
    Set objFile = Nothing
    Set objFSO = Nothing
    MsgBox "Done"
End Sub

Open in new window

0
 
bsharathAuthor Commented:
Sorry missed your last response.
Point 2 is
The mails that should be shown in the followup are
Mails flagged for follow up.

When i create this search manually i get just the flagged mails that are flagged red. Nothing else.
Can i get just them.
As now i get the attached mails flagged which have a flag and a body image
Capturxse.JPG
0
 
David LeeCommented:
That icon simply means that the item was flagged for the recipient.  In other words, instead of you flagging the message yourself the sender flagged it before sending it to you.  The red flag has the same meaning, the addition of the body icon simply lets you know that the sender sent the flag.
0
 
bsharathAuthor Commented:
Ok but the flaggged items by me does not show up at all....
0
 
David LeeCommented:
Replace line 31 of MakeMySearchFolders with this

    Set olkSearch = Application.AdvancedSearch(strFolderList, """urn:schemas:httpmail:messageflag"" LIKE '%Follow up%'", True, "For Follow Up")
0
 
bsharathAuthor Commented:
Perfect but i get the completed
the ticked mails also shown in the folders. Can i get just the flagged ones
0
 
bsharathAuthor Commented:
Perfect but i get the completed
the ticked mails also shown in the folders. Can i get just the flagged ones
0
 
David LeeCommented:
Replace line 31 with this

    Set olkSearch = Application.AdvancedSearch(strFolderList, "(""urn:schemas:httpmail:messageflag"" = 'Follow up' AND ""http://schemas.microsoft.com/mapi/proptag/0x10910040"" IS NULL)", True, "For Follow Up")

This won't just get red flags.  It'll get the pinkish ones too.  There doesn't appear to be a way to get just the red ones.
0
 
bsharathAuthor Commented:
Thanks a lot David now all are fine
Can the script add to favorites if it has the followup folder already
As the followup folders some times can be there in 1 or more psts and just adding to favorites may be required.
Like check for for the followup folder if there add to favorites
0
 
bsharathAuthor Commented:
Thanks a lot David now all are fine
Can the script add to favorites if it has the followup folder already
As the followup folders some times can be there in 1 or more psts and just adding to favorites may be required.
Like check for for the followup folder if there add to favorites
0
 
bsharathAuthor Commented:
Thanks a lot David works perfect...This is one excellent help...
0
 
bsharathAuthor Commented:
Thanks a lot David works perfect...This is one excellent help...
0
 
David LeeCommented:
You're welcome.  Sorry it took so long to work out all the details.
0
 
bsharathAuthor Commented:
No problem David it came out well... :-)
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.