U
udo
Hi,
My Outlook 2007 archives emails to a "archivel" folder tree structure
that is parallel to my mailbox folders.
I've written a macro that switches between a folder and its archive
(see below)
As a safety measure, I want the "archivel" folder collapsed
altogether
when I switch back to the non-archive folder, so that I don't confuse
its folders with the normal ones - any Idea how I do this?
Thanx in advance.
----------------------------------
Sub SwitchBetweenCurrentFolderAndItsArchive()
Dim names As Collection
Set names = New Collection
Dim cf As Folder
Set cf = Application.ActiveExplorer.CurrentFolder
Set f = cf
Do While Not f Is Nothing And TypeOf f Is MAPIFolder
names.Add (f.Name)
Set f = f.Parent
Loop
Dim newf As Folder
If names(names.Count) <> "Archivel Folders" Then
Set newf = f.Folders("Archivel Folders")
MsgBox "Switching from a folder to its ARCHIVE"
Else
Set newf = f.GetDefaultFolder(olFolderInbox).Parent
MsgBox "Switching from an archive back to its FOLDER"
End If
' remove 'mailbox' item
names.Remove (names.Count)
While names.Count > 0
'MsgBox names.Item(names.Count)
Set newf = newf.Folders(names.Item(names.Count))
names.Remove (names.Count)
Wend
Set Application.ActiveExplorer.CurrentFolder = newf
End Sub
My Outlook 2007 archives emails to a "archivel" folder tree structure
that is parallel to my mailbox folders.
I've written a macro that switches between a folder and its archive
(see below)
As a safety measure, I want the "archivel" folder collapsed
altogether
when I switch back to the non-archive folder, so that I don't confuse
its folders with the normal ones - any Idea how I do this?
Thanx in advance.
----------------------------------
Sub SwitchBetweenCurrentFolderAndItsArchive()
Dim names As Collection
Set names = New Collection
Dim cf As Folder
Set cf = Application.ActiveExplorer.CurrentFolder
Set f = cf
Do While Not f Is Nothing And TypeOf f Is MAPIFolder
names.Add (f.Name)
Set f = f.Parent
Loop
Dim newf As Folder
If names(names.Count) <> "Archivel Folders" Then
Set newf = f.Folders("Archivel Folders")
MsgBox "Switching from a folder to its ARCHIVE"
Else
Set newf = f.GetDefaultFolder(olFolderInbox).Parent
MsgBox "Switching from an archive back to its FOLDER"
End If
' remove 'mailbox' item
names.Remove (names.Count)
While names.Count > 0
'MsgBox names.Item(names.Count)
Set newf = newf.Folders(names.Item(names.Count))
names.Remove (names.Count)
Wend
Set Application.ActiveExplorer.CurrentFolder = newf
End Sub