自定义将规定好的工作簿划分分类到指定的文件夹中

dyh酋长

各位大神好，我有一个问题，就是有一批差不多几百个工作簿需要按照自定义好的规则，将其划分到指定的文件夹，我在论坛上找了一些代码，但是，一直运行不起来，麻烦各位帮我看看什么问题，怎么解决

tearsky621

考虑用CMD命令呀，个人感觉会更快呢。

dyh酋长

tearsky621 发表于 2018-9-20 11:34
考虑用CMD命令呀，个人感觉会更快呢。

有代码吗，具体怎么操作，这个我不是很理解

dyh酋长

tearsky621 发表于 2018-9-20 11:34
考虑用CMD命令呀，个人感觉会更快呢。

有代码吗，具体怎么操作，这个我不是很理解

xiangbaoan

1、文件夹名是事先建好了?还是根据文件名去自动创建?
2、请文件夹命名规则是不是 ：
    A、是数字的文件就创建 数字 文件夹?
    B、不是数字，就取文件名前3个字符建立新的文件夹?
补充：
Sub test()
Dim fso As Object, f, fld$, fnm$, p$, np$
Set fso = CreateObject("scripting.filesystemobject")
p = ThisWorkbook.Path & "\"
For Each f In fso.GetFolder(p).Files
    If InStr(f.Name, ".xl") And f.Name <> ThisWorkbook.Name And Left(f.Name, 2) <> "~$" Then
        fnm = Split(f.Name, ".xl")(0)
        If IsNumeric(fnm) Then
            fld = p & "数字"
        Else
            fld = p & Left(fnm, 3)
        End If
        If Not fso.FolderExists(fld) Then fso.CreateFolder (fld)
        If fso.FileExists(fld & "\" & f.Name) Then
            fso.MoveFile f, fld & "\(副本)" & f.Name
        Else
            fso.MoveFile f, fld & "\" & f.Name
        End If
    End If
Next
Set fso = Nothing
End Sub

dyh酋长

xiangbaoan 发表于 2018-9-20 12:27
1、文件夹名是事先建好了?还是根据文件名去自动创建?
2、请文件夹命名规则是不是 ：
    A、是数字的文件 ...

附件里面有一个操作的表，文件名是工作簿的名字，文件夹名和文件名都是自定义，就是事先按照表里工作簿名和对应文件夹名，进行工作簿分类移动到文件夹

dyh酋长

xiangbaoan 发表于 2018-9-20 12:27
1、文件夹名是事先建好了?还是根据文件名去自动创建?
2、请文件夹命名规则是不是 ：
    A、是数字的文件 ...

文件夹是事先建好的，因为工作簿的名字和文件夹的名字没有直接关系，主要是我有一批工作簿，命名没有太多规律，但是根据要求，我要把其中的一些工作簿放到指定的文件夹，所以我事先在表里面提供两列数据，一列是我的工作簿名称，一列是文件夹名，然后我就把我的工作簿放到对应的文件夹里去

dyh酋长

xiangbaoan 发表于 2018-9-20 12:27
1、文件夹名是事先建好了?还是根据文件名去自动创建?
2、请文件夹命名规则是不是 ：
    A、是数字的文件 ...

文件夹的名字可以我事先放在表里面吗，因为文件夹的名字要求比较复杂，我刚试了一下已经解决的工作簿移动的功能，但是我想把工作簿移动到对应的文件夹名，但是因为我的文件夹名字可能不是去工作簿的前三个，所以我想能不能改成，文件夹的名字是由表里面的数据来命名

xiangbaoan

dyh酋长 发表于 2018-9-20 14:04
文件夹的名字可以我事先放在表里面吗，因为文件夹的名字要求比较复杂，我刚试了一下已经解决的工作簿移动 ...

Option Explicit
Sub test()
Dim ar, d As Object, fso As Object, f, fld, p$, lr&, i%
Set d = CreateObject("scripting.dictionary")
Set fso = CreateObject("scripting.filesystemobject")
p = ThisWorkbook.Path & "\"
lr = [a65536].End(xlUp).Row
ar = [a1].Resize(lr, 2)
For i = 2 To lr
    d(ar(i, 1) & "") = ar(i, 2)
Next
For Each f In fso.GetFolder(p).Files
    If InStr(f.Name, ".xl") And f.Name <> ThisWorkbook.Name And Left(f.Name, 2) <> "~$" Then
        If d.Exists(Split(f.Name, ".xl")(0) & "") Then
            fld = p & d(Split(f.Name, ".xl")(0) & "")
            If Not fso.FolderExists(fld) Then fso.CreateFolder (fld)
            If fso.FileExists(fld & "\" & f.Name) Then
                fso.MoveFile f, fld & "\(副本)" & f.Name
            Else
                fso.MoveFile f, fld & "\" & f.Name
            End If
        End If
    End If
Next
Set d = Nothing
Set fso = Nothing
End Sub

dyh酋长

xiangbaoan 发表于 2018-9-20 12:27
1、文件夹名是事先建好了?还是根据文件名去自动创建?
2、请文件夹命名规则是不是 ：
    A、是数字的文件 ...

这个是我其中一个工作簿的名称（武诗毅056丁川  12申报：异网：上海百集鞋业有限公司），或者说能不能文件夹名去第一个空格前的内容