The following should work. Try it on a sub folder with a few messages. The macro will prompt for the folder to start at and it will process that folder and the folders under it.
Option Explicit
Sub AddCategoryToSF()
Dim cFolders As Collection
Dim olFolder As Outlook.Folder
Dim SubFolder As Folder
Dim olNS As Outlook.NameSpace
On Error Resume Next
Set cFolders = New Collection
Set olNS = GetNamespace("MAPI")
cFolders.Add olNS.PickFolder
Do While cFolders.Count > 0
Set olFolder = cFolders(1)
cFolders.Remove 1
ProcessFolder olFolder
For Each SubFolder In olFolder.folders
cFolders.Add SubFolder
Next SubFolder
Loop
lbl_Exit:
Set olFolder = Nothing
Set SubFolder = Nothing
Exit Sub
err_Handler:
GoTo lbl_Exit
End Sub
Sub ProcessFolder(oFolder As Folder)
Dim i As Long
Dim olItem As Object
'Debug.Print oFolder
For i = 1 To oFolder.items.Count
Set olItem = oFolder.items(i)
If TypeName(olItem) = "MailItem" Then
If olItem.Subject Like "SF*" Then
olItem.Categories = Left(olItem.Subject, 6)
End If
End If
Next i
lbl_Exit:
Set olItem = Nothing
Exit Sub
End Sub