Question

我目前正在尝试将宏放在一起，根据文件名将文件排序到文件夹中。由于我们所使用的系统，我被锁定使用VBA。

例如，仅从C：\：

中的下方排序excel文档

123DE.xls
124DE.xls
125DE.xls
124.doc
123.csv

进入以下文件夹路径：

C:\Data\123\Data Extract
C:\Data\124\Data Extract
C:\Data\125\Data Extract

已创建文件夹，并且在示例中以文件的前x个字符命名。需要将5000多个文件批量分类到超过5000个文件夹中，以便我尽量避免编码每个文件名

我对VBA很新，所以任何指导都会非常感激。到目前为止，我已设法将所有excel文件移动到一个文件夹中，但我不确定如何进展。

Sub MoveFile()

Dim strFolderA As String
Dim strFolderB As String
Dim strFile as String

strFolderA = "\\vs2-alpfc\omgusers7\58129\G Test\"
strFolderb = "\\vs2-alpfc\omgusers7\58129\G Test\1a\"
strFile = Dir(strFolderA & "*.xlsx*")

Do While Len(strFile) >0
    Name StrFolderA & strFile As strFolderB & strFile
    strFile = Dir
Loop

End Sub

格雷格

修改

Sub MoveFile()

Dim strFolderA As String
Dim strFile As String
Dim AccNo As String

strFolderA = "\\vs2-alpfc7\omgUSERS7\58129\G Test\"

strFile = Dir(strFolderA & "*.xlsx*")

Do While Len(strFile) > 0

AccNo = Left(strFile, 2)

    Name strFolderA & strFile As strFolderA & "\" & AccNo & "\Data Extract\" & strFile

    strFile = Dir
Loop

End Sub

谢谢大家，我想添加一些零碎的东西，但功能就在那里！

Answer 1

Sub DivideFiles()
Const SourceDir = "C:\"  'where your files are
Const topdir = "\\vs2-alpfc\omgusers7\58129\G Test\"

Dim s As String
Dim x As String
s = Dir(SourceDir & "\*.xls?")
Do
x = Left(s, 3) 'I assume we're splitting by first three chars

Name SourceDir & s As topdir & s & "\" & s

Loop Until s = ""
End Sub

Answer 2

如果我理解正确，问题是从文件名派生新的fullpathname以用作newpathname函数的Name参数。

如果您的所有文件都以DE.XLS*结尾，则可以执行以下操作：

NewPathName = C:\Data\ & Split(strFile, "DE")(0) & "\Data Extract\" & strFile

Answer 3

您可以使用Filesystem对象（工具＆gt;参考＆gt; microsoft脚本运行时

首先复制然后删除。您可以注释掉删除行并安全地执行检查复制。

如果在Mac上更换＆＃34; \＆＃34;与Application.PathSeparator。

基于假设，如您所述，文件夹已经存在。

 Option Explicit

Sub FileAway()

    Dim fileNames As Collection
    Set fileNames = New Collection

    With fileNames
        .Add "123DE.xls"
        .Add "124DE.xls"
        .Add "125DE.xls"
        .Add "124.doc"
        .Add "123.csv"
    End With

    Dim fso As FileSystemObject                  'tools > references > scripting runtime
    Set fso = New FileSystemObject

    Dim i As Long
    Dim sourcePath As String
    sourcePath = "C:\Users\User\Desktop"      'where files currently are

    For i = 1 To fileNames.Count

        If Not fso.FileExists("C:\Data\" & Left$(fileNames(i), 3) & "\Data Extract\" & fileNames(i)) Then

            fso.CopyFile (sourcePath & "\" & fileNames(i)), _
            "C:\Data\" & Left$(fileNames(i), 3) & "\Data Extract\", True

            fso.DeleteFile (sourcePath & "\" & fileNames(i))
        End If

    Next i

End Sub

使用excel VBA自动将文件排序到文件夹中

3 个答案: