1. In your references, make sure to have "Microsoft Scripting Runtime" checked off.
2. Here's the code for a function that goes through all the files in the folder mentioned in foldername and makes a folder out of them.
Private Function CreateFolders(folderName As String)
Dim fso As New FileSystemObject
Dim rootfolder As Folder
Dim curobject As File
Set rootfolder = fso.GetFolder(folderName)
Dim segment As String 'stores the last three chars.
For Each curobject In rootfolder.Files
segment = Mid(curobject.Name, 5, 3)
If fso.FolderExists(folderName & "\" & segment) = False Then
fso.CreateFolder (folderName & "\" & segment)