What I suspect you are looking for is something like the following. The macro runs on the selected message and determines whether it has categories. If it does it moves a copy of the message to a folder bearing the category name that is a subfolder of Inbox. If the folder doesn't exist it is created. If there is no category it prompts for one then moves the message to the category named folder (or creates that folder, if it doesn't exist). The original message is then deleted.
Sub MoveMessageToCategoryFolder()
'Graham Mayor - https://www.gmayor.com - Last updated - 06 Aug 2020
Dim olMsg As Object, objCopy As Object
Dim vCategory As Variant
Dim strFolder As String
Dim olFolder As Folder, olSubFolder As Folder
Dim i As Integer
Dim bFound As Boolean
On Error Resume Next
Select Case Outlook.Application.ActiveWindow.Class
Case olInspector
Set olMsg = ActiveInspector.currentItem
Case olExplorer
Set olMsg = Application.ActiveExplorer.Selection.Item(1)
End Select
GetCategories:
If TypeName(olMsg) = "MailItem" Then
Set olFolder = Session.GetDefaultFolder(olFolderInbox)
If olMsg.Categories <> "" Then
vCategory = Split(olMsg.Categories, ",")
For i = 0 To UBound(vCategory)
bFound = False
strFolder = Trim(vCategory(i))
For Each olSubFolder In olFolder.folders
If olSubFolder.Name = strFolder Then
Set objCopy = olMsg.Copy
objCopy.Move olSubFolder
bFound = True
Exit For
End If
Next olSubFolder
If Not bFound Then
Set olSubFolder = olFolder.folders.Add(strFolder)
Set objCopy = olMsg.Copy
objCopy.Move olSubFolder
End If
Next i
Else
olMsg.ShowCategoriesDialog
GoTo GetCategories
End If
olMsg.Delete
End If
lbl_Exit:
Exit Sub
End Sub