To answer both your questions, 'Dim objMsg As MailItem' requires that all the items checked are actually mail items. If there are mixed item types in the folder use
Code:
Dim objMsg As Object
The code suggested was for a single message.
The code checks that the appropriate folder exists for each message and creates it only if missing; and as you wanted to avoid hard coding the path, it also locates the named folder in the folder tree in order to move the message to it. If however you want to process a folder full of messages into the same sub folder , then lose the function and process the messages in a loop in the main macro, testing for the folder with the first message only e.g. as follows.
Process the messages in reverse order so that the movement of the messages doesn't upset the count.
The process moves all the messages from the selected startfolder to the named sub folder of that startfolder.
Code:
Option Explicit
Sub MoveMessages()
Dim olNS As NameSpace
Dim cFolders As Collection
Dim strFolderName As String
Dim olFolder As Outlook.Folder
Dim StartFolder As Outlook.Folder
Dim SubFolder As Outlook.Folder
Dim olItem As Object
Dim bExists As Boolean
Dim iMsg As Integer
Set cFolders = New Collection
Set olNS = GetNamespace("MAPI")
strFolderName = InputBox("Enter the name of the folder to move the messages to") 'The target folder
Set StartFolder = olNS.PickFolder
For iMsg = StartFolder.Items.Count To 1 Step -1
Set olItem = StartFolder.Items(iMsg)
If iMsg = StartFolder.Items.Count Then
cFolders.Add StartFolder
Do While cFolders.Count > 0
Set olFolder = cFolders(1)
cFolders.Remove 1
If UCase(olFolder.Name) = UCase(strFolderName) Then
bExists = True
Exit Do
End If
For Each SubFolder In olFolder.folders
cFolders.Add SubFolder
Next SubFolder
Loop
If Not bExists Then
Set olFolder = StartFolder.folders.Add(strFolderName)
End If
End If
olItem.Move olFolder
Next iMsg
lbl_Exit:
Set olNS = Nothing
Set StartFolder = Nothing
Set cFolders = Nothing
Set olFolder = Nothing
Set olItem = Nothing
Exit Sub
End Sub