This might do it:

Sub RenameFolder()

Dim myNameSpace As NameSpace
Dim fldFolder As MAPIFolder
Dim blnMore As Boolean
Dim strNewName As String

Set myNameSpace = GetNamespace("MAPI")
blnMore = True

Do
 Set fldFolder = myNameSpace.PickFolder
 If Not fldFolder Is Nothing Then
   strNewName = InputBox("New Folder Name for " & fldFolder.Name & ":", "Rename Folders")
   If strNewName <> "" Then
     fldFolder.Name = strNewName
   Else
     blnMore = False
   End If
 Else
   blnMore = False
 End If
Loop Until Not blnMore
End Sub