请教高手用vba实现根据文件名将文件分类放入新建的文件夹中

VB6 ，可以使用 Filelist 取文件名，然后截中间的部分，再使用 NAME 命令移动文件。

VBA ？ 可以使用 DIR 命令，循环取文件名，然后 处理 与上面相同....
可以使用FSO 对象，取目录下的文件名，然后 处理 ....

前几天回复的一个是示例，稍微修改了一下，请参考
【仅对execl扩展名进行了保存，多个，你可以修改filename变量和保存变量】
 FileName = Dir(app.Path & "\*.xlsx")
 Do While FileName <> ""
  N_PATH = app1.Path '定义保存路径，可自己定义保存位置
  N_NAME = N_PATH & filename '定义保存文件路径及原文件名
  ActiveWorkbook.SaveAs N_NAME
  FileName = Dir
Loop

Dim s            '每个文件名
Dim p             '输入的路径
Dim fso
Dim getfso
Dim Filelist
Dim fileobj


p = InputBox("请输入文件路径", "路径", "e:\aa")

If Len(p) > 1 Then                '最少长度2
    If Mid(p, 2, 1) = ":" Then            '是否包含驱动器符号
        '全部符合，通过，不提示错误
    Else
        MsgBox "没有包含驱动器符号！", 16
        Wscript.Qui
    End If
Else
    MsgBox "未输入路径！", 16
    Wscript.Qui
End If

If Right(p, 1) <> "\" Then        '补最后的 \
    p = p & "\"
End If

Set fso = CreateObject("Scripting.FileSystemObject")
getfso = fso.FolderExists(p)        '判断目录是否存在

If Not getfso Then
    MsgBox "输入的路径无效！", 16
    Wscript.Qui
End If

Set Filelist = fso.GetFolder(p)        '读目录

For Each fileobj In Filelist.Files    '循环读取所有的文件
    s = fileobj.Name            '取文件名
    '后面自己完成：
    '使用 mid 取字符串
    '使用 fso.FolderExists(全路径) 判断目录是否存在
    '不存在使用 fso.CreateFolder 全路径 创建目录
    '使用 fso.MoveFile "要移动及改名的原文件路径","移动到某路径及自定义新文件名"
    '移动到某路径，这个路径，可以用前面的方法，放到第一个输入路径后，再提示 用户输入。输入后如果判断路径不存在，则创建。

msgbox s    '显示文件名
Next