Outlook Crashes when trying to Move Messages between Folders

[Tim]

In order to help manage my messages I have created a VBA
macro that will search my folder tree for folders that
have a string in the folder name. The macro opens a new
Outlook Window for each folder that has the string in the
title. I use this to move messages to these folders
(usually from my inbox).

The macro was working fine for some time (a year or more).
They are now causing Outlook to crash when I try to move a
folder from my inbox to one of the open folders. When I
try to drag the message I get a "NOT" symbol (the 0 with a
line through it)... and at this point I cannot do anything
and have to kill outlook to recover.

I made some tweaks to the macro recently, which may have
caused this problem, but I simply cannot figure out why.

Macro is attached. Starting macro
is "search_by_folder_tim".
Const yStart1 = 400 ' Where to start placing
the result folders
Const yStart2 = 0 ' Where to start placing
the INBOX and OUTBOX
Const StartHeight = 375 ' The starting height of
the explorer windows
Const StartWidth = 1000 ' The starting width of
the explorer windows

Dim mySentboxFolder As String ' The name of the folder
that contains your Sent Box
Dim mySentboxBox As String ' The name of your Sent
Box
Dim FirstSearchFolder As String ' The name of the first
folder (and subfolders) to search

Dim SecondSearchFolder As String ' The name of the second
folder (and subfolders) to search
Dim numfolders As Integer ' The number of folders
to search. Set to 1 if you only want
' to search the
FirstSearchFolder
Dim myInboxFolder As String ' The name of the folder
that contains your Inbox
Dim myInboxBox As String ' The name of your Inbox

Dim olApp As Outlook.Application
Dim olSession As Outlook.NameSpace
Dim olstartfolder As Outlook.MAPIFolder
Dim Fyear(1 To 2) As Outlook.MAPIFolder

Dim strSearchString As String
Dim lCountOfFound As Long
' Change ExitOnFirst to TRUE if you want to exit after the
first folder is
' found. Could be used to generate a popup to allow the
user to "findNext"
' or Exit.
Dim ExitOnFirst As Boolean
Dim WindowIsNormal As Boolean
Dim oeExplorer As Explorer
Dim yOffset As Integer
Dim xOffset As Integer
Dim yStartOffset As Integer

Sub search_by_folder_tim()
' Get a reference to the Outlook application and session.
Set olApp = Application
Set olSession = olApp.GetNamespace("MAPI")
mySentboxFolder = "2004-1"
mySentboxBox = "Sent Items"
FirstSearchFolder = "2004"
SecondSearchFolder = ""
Set Fyear(1) = olSession.Folders(FirstSearchFolder)
Set Fyear(2) = Nothing
numfolders = 1
myInboxFolder = "2004-1"
myInboxBox = "Inbox"
SearchFolderName
End Sub
Sub SearchFolderName()

Dim olReturnToFolder As Outlook.MAPIFolder
Dim strPrompt As String
Dim FolderFound As Boolean
Dim ExitAfterFirstYear As Boolean

ExitAfterFirstYear = False
FolderFound = False
ExitOnFirst = False
WindowIsNormal = False
yOffset = 0
xOffset = 0
yStartOffset = yStart1

Set olReturnToFolder =
Application.ActiveExplorer.CurrentFolder
Set oeExplorer = Application.ActiveExplorer

' Allow the user to input the search string.
strPrompt = "Folder Name Contains:"
strSearchString = InputBox(strPrompt)

For TheYear = 1 To numfolders
If strSearchString <> "" Then
Set olstartfolder = Fyear(TheYear)

If Not (olstartfolder Is Nothing) Then
' Start the search process.
FolderFound = ProcessFolder(olstartfolder) Or
FolderFound
End If
End If
If (FolderFound And ExitAfterFirstYear) Then
Exit For
End If
Next
If (Not FolderFound) Then
MsgBox "Folder not found."
Else
oeExplorer.Activate
' try to get the current selected message back in
view.
oeExplorer.CurrentFolder.Display
End If
End Sub
Function ProcessFolder(CurrentFolder As
Outlook.MAPIFolder) As Boolean

Dim i As Long
Dim olNewFolder As Outlook.MAPIFolder
Dim cfExplorer As Explorer

ProcessFolder = False

If InStr(1, CurrentFolder.Name, strSearchString, 1) >
0 Then
If Not WindowIsNormal Then
WindowIsNormal = True
oeExplorer.WindowState = olNormalWindow
oeExplorer.Height = StartHeight
oeExplorer.Left = 0
oeExplorer.Top = 0
oeExplorer.Width = StartWidth
End If

Set cfExplorer = CurrentFolder.GetExplorer
cfExplorer.Height = StartHeight - yOffset
cfExplorer.Left = 0 + xOffset
cfExplorer.Top = yStartOffset + yOffset
cfExplorer.Width = StartWidth - xOffset
yOffset = yOffset + 20
If yOffset > 200 Then
yOffset = 0
xOffset = xOffset + 100
End If
If xOffset > 500 Then
xOffset = 0
End If
CurrentFolder.Display
ProcessFolder = True
If ExitOnFirst Then
Exit Function
End If
End If

' Loop through and search each subfolder of the
current folder.
For Each olNewFolder In CurrentFolder.Folders
If (ProcessFolder(olNewFolder)) Then
ProcessFolder = True
If ExitOnFirst Then
Exit Function
End If
End If
Next
End Function