Solved: rename multiple subfolders in outlook inbox

[OTWarrior]

One of my team has a load of subfolders he has created in the following format:

123456780 John Smith
123456788 Jane Jones

Since Outlook arranges it's folders alphabetically, he would like to change his folders to be in this format:

Jane Jones 123456788
John Smith 123456780


Since there are about 50 of these folders, I said I would probably be easier to make a macro for this (I know, I am a glutton for punishment ;)

So far I have been able to find the name of the current folder using the following code:

Sub DisplayCurrentFolderName()
Dim myOlApp As Outlook.Application
Dim myExplorer As Outlook.Explorer
Dim myFolder As Outlook.MAPIFolder
Set myOlApp = CreateObject("Outlook.Application")
Set myExplorer = myOlApp.ActiveExplorer
Set myFolder = myExplorer.CurrentFolder

MsgBox myFolder.Name

End Sub

I am fairly certain a loop and/or array is needed to do this, but I am uncertain how to move to the next folder within a subfolder of outlook.

Any help with this would be much appreciated.:thumb

[Charlize]

Create another variable named mySubFolder and dim it also as a Outlook.MAPIFolder.

Then use a loop :
For each mySubFolder in MyFolder
'... code to alter name of mySubFolder
Next mySubFolder

Just an idea.

Charlize

[Charlize]

I assume you are already in outlook when you want to perform this kind of action. Here some coding. Try it first on some bogus folder with several subfolders. Subfolders have this naming convention : numbers space name (name with one item or several) ie. 1234567890123 It is me will become It is me 1234567890123 (I hope).

Sub display_Subfolders()
'your headfolder
Dim myfolder As Outlook.MAPIFolder
'subfolders of your headfolder
Dim mysubfolder As Outlook.MAPIFolder
'array to use to hold the items as a result of split
Dim newname As Variant
'loop to use when looping items in array newname
Dim loopname As Long
'the string we create with the items of newname
Dim resultname As String
'pick your folder to process
Set myfolder = Session.PickFolder
'if error goto errorfound
On Error GoTo errorfound
'when you cancel the dialogbox without chosing a folder,
'you'll get an error
If myfolder <> False Then
'reset error trapping to not to go to errorfound
On Error GoTo 0
MsgBox "Folder chosen : " & myfolder.Name, _
vbInformation, "Headfolder ..."
For Each mysubfolder In myfolder.Folders
MsgBox "Subfolder of " & myfolder.Name & vbCrLf & _
"--- " & mysubfolder.Name & " ---", _
vbInformation, "Subfolder ..."
'split name of folder based on space
newname = Split(mysubfolder, " ")
'loop through items of newname
For loopname = LBound(newname) To UBound(newname)
'skip first item of newname (numbers)
If loopname <> 0 Then
'create new name and store it in resultname
resultname = resultname & " " & newname(loopname)
End If
'next item in array
Next loopname
'add the number which was the first item ie. 0
'standard we assume 0. if you want 1 use option base 1
'on top of this procedure (where we dim the variables)
resultname = resultname & " " & newname(0)
'rename the subfolder with new name
mysubfolder.Name = resultname
'clear resultname
resultname = ""
Next mysubfolder
Else
MsgBox "No folder has been chosen.", vbInformation, "Headfolder ..."
End If
MsgBox "Everything with your subfolders has been done.", _
vbInformation, "Final message ..."
'we don't want to see the errormessage so end this procedure
Exit Sub
errorfound:
MsgBox "Something went wrong : " & Err.number & vbCrLf & _
Err.Description & vbCrLf & _
"-> Select a folder to process. <-", vbInformation, "Error ..."
End Sub
Charlize

[OTWarrior]

That is perfect Charlize...thank you very much :)