IPath = "T:\FOLDER-1"
TPath = "T:\FOLDER-2\FIL"
Filt = "*.fil"
Set FSO = CreateObject("Scripting.FilesystemObject")
Set Shell = CreateObject("Shell.Application")
If Not FSO.FolderExists(TPath) Then FSO.CreateFolder TPath
FFolder IPath
Sub FFolder(Folder)
Set Items = Shell.NameSpace(Folder).Items
Items.Filter 73920, Filt
For Each F In Items
Trg = FSO.BuildPath(TPath, UCase(Left(F.Name, 2)))
If Not FSO.FolderExists(Trg) Then FSO.CreateFolder Trg
Shell.NameSpace(Trg).MoveHere F, 280
Next : Items.Filter 73888, "*"
For Each F In Items : FFolder F.Path : Next
End Sub
TPath = "T:\FOLDER-2\TXT"
Filt = "*.txt"
Set FSO = CreateObject("Scripting.FilesystemObject")
Set Shell = CreateObject("Shell.Application")
If Not FSO.FolderExists(TPath) Then FSO.CreateFolder TPath
FFolder IPath
Sub FFolder(Folder)
Set Items = Shell.NameSpace(Folder).Items
Items.Filter 73920, Filt
For Each F In Items
Trg = FSO.BuildPath(TPath, UCase(Left(F.Name, 2)))
If Not FSO.FolderExists(Trg) Then FSO.CreateFolder Trg
Shell.NameSpace(Trg).MoveHere F, 280
Next : Items.Filter 73888, "*"
For Each F In Items : FFolder F.Path : Next
End Sub
TPath = "T:\FOLDER-2\LST"
Filt = "*.lst"
Set FSO = CreateObject("Scripting.FilesystemObject")
Set Shell = CreateObject("Shell.Application")
If Not FSO.FolderExists(TPath) Then FSO.CreateFolder TPath
FFolder IPath
Sub FFolder(Folder)
Set Items = Shell.NameSpace(Folder).Items
Items.Filter 73920, Filt
For Each F In Items
Trg = FSO.BuildPath(TPath, UCase(Left(F.Name, 2)))
If Not FSO.FolderExists(Trg) Then FSO.CreateFolder Trg
Shell.NameSpace(Trg).MoveHere F, 280
Next : Items.Filter 73888, "*"
For Each F In Items : FFolder F.Path : Next
End Sub