将pdf根据文件名里的编码新建一个文件夹，并将具有相同编码的pdf文件放入相同的文件夹中

[此贴子已经被作者于2017-12-24 23:01编辑过]

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

第一次写 VBA 代码，
还是习惯用 VB6 去写，结果 一运行就报错。