Excel 如何基于第一个和最后一个文件名将100个文件复制到文件夹，并在列表框vba中显示

我试图想出一个脚本，让我从一个文件夹复制100个文件，并根据第一个文件和最后一个文件名创建一个新文件夹，然后将这100个文件移动到该文件夹。 移动这些文件后，我希望它在userform列表框中将文件夹显示为可单击的项目。 例如，列表框中的每个项目都将是一个文件夹，如果我双击文件夹名称，它将在我设置的工作表中显示文件（100个文件中的每个文件）的所有内容

我还没有能够测试这段代码，过去一周我所做的只是反复研究和重写代码，直到我能够正确理解它，然后再将其添加到程序中。因此，在这个过程中肯定会出现一些或更多的错误

我注意到的是“objFile.CopyFile Folderpath&FCount&“quot&LCount”代码段，它没有指定可以专门复制哪些文件。例如，我希望它从第一个文件开始，开始处理前100个文件，当代码再次执行时，它将从文件101开始，并复制下100个文件。如果有办法确保它不会继续复制前100个文件，那就太棒了

Sub Main()
'====CHECK IF THERE'S 100 FILES====

    Dim filename, folderpath, path As String
    Dim count As Integer
    Dim FCount, LCount, FlagCount, IntCount As Integer
    Dim objFSO As Object
    Dim obj As Object

    FCount = 0                                        ' First File name
    LCount = 0                                        'Last file name
    count = 0                                         'file count
    FlagCount = Sheets("Flag Sheet").Range("A2").Value

    folderpath = "Work\Big Book\"                     '==================Location Of The Book
    path = folderpath & "*.xls"
    filename = Dir(path)

    Do While filename <> ""
        count = count + 1
        filename = Dir(path)
    Loop
If count < 100 Then

        '====CREATE A FOLDER FOR THE FILES====

        If FlagCount <> "" Then                       '====If there is a flag count, it will create a folder based on the last number it was used
            FCount = FlagCount + 1
            LCount = FlagCount + 101
            MkDir folderpath & FCount & "_" & LCount
        Else                                          '=======================else if there isnt one, it will use the first file name to create the folder
            FCount = IntCount + 1
            LCount = IntCount + 100
            MkDir folderpath & FCount & "_" & LCount
        End If


        '====MOVE 100 FILES TO FOLDER====


        For Each objFile In objFSO.GetFolder(path)
            If FlagCount <> "" Then                   '====================if theres a flag count it will move the files starting after the flag count + 101
                objFile.CopyFile folderpath & FCount & "_" & LCount
                IntCount = FlagCount + 1
                If IntCount = FlagCount + 100 Then Exit For
            Else                                      '======================================else it will just move the first 100 files
                objFile.CopyFile folderpath & FCount & "_" & LCount
                IntCount = IntCount + 1
                If IntCount = IntCount + 100 Then Exit For
            End If
        Next

    End If

Else
    '===Do Nothing===
End If

End Sub

'=====Display Folders In Listbox=====
    '====Display Folder Items In Book====


'Call the function
DisplayFoldersInListBox folderpath & FCount & "_" & LCount, Me.Listbox1

Sub Button_Click()

    For Each File in Folderpath & FCount & "_" & LCount & "\" & Listbox.value
        '[INSERT BIG BOOK CODE]

    Next

End Sub

Private Sub DisplayFoldersInListBox(ByVal strRootFolder As String, ByRef lbxDisplay As MSForms.ListBox)

    Dim fso As Object
    Dim fsoRoot As Object
    Dim fsoFolder As Object

    'Make sure that root folder contains trailing backslash
    If Right$(strRootFolder, 1) <> "\" Then strRootFolder = strRootFolder & "\"

    'Get reference to the FileSystemObject
    Set fso = CreateObject("Scripting.FileSystemObject")

    'Get the root folder
    Set fsoRoot = fso.GetFolder(strRootFolder)

    'Clear the listbox
    lbxDisplay.Clear

    'Populate the listbox with subfolders of Root
    For Each fsoFolder In fsoRoot.SubFolders
        lbxDisplay.AddItem fsoFolder.Name
    Next fsoFolder

    'Clean up
    Set fsoRoot = Nothing
    Set fso = Nothing

End Sub

Sub-Main（）
'==检查是否有100个文件====
Dim文件名、文件夹路径、路径为字符串
将计数设置为整数
Dim FCount、LCount、FlagCount、IntCount作为整数
作为对象的Dim objFSO
作为对象的Dim obj
FCount=0'第一个文件名
LCount=0'最后一个文件名
计数=0'文件计数
FlagCount=工作表（“工作表”）.范围（“A2”）.值
folderpath=“Work\Big Book\”============================书籍的位置
path=folderpath&“*.xls”
filename=Dir（路径）
文件名“”时执行此操作
计数=计数+1
filename=Dir（路径）
环
如果计数小于100，则
'==为这些文件创建一个文件夹====
如果FlagCount为“”，则“===如果存在标志计数，则它将基于上次使用的编号创建文件夹
FCount=FlagCount+1
LCount=FlagCount+101
MkDir folderpath&FCount&“quot&LCount”
Else'==============================如果没有，它将使用第一个文件名创建文件夹
FCount=IntCount+1
LCount=IntCount+100
MkDir folderpath&FCount&“quot&LCount”
如果结束
'==将100个文件移动到文件夹====
对于objFSO.GetFolder（路径）中的每个objFSO文件
如果FlagCount为“”，则“============================如果存在标志计数，则将从标志计数+101后开始移动文件
objFile.CopyFile folderpath&FCount&“\u”&LCount
IntCount=FlagCount+1
如果IntCount=FlagCount+100，则退出
Else'===============================================================否则它将只移动前100个文件
objFile.CopyFile folderpath&FCount&“\u”&LCount
IntCount=IntCount+1
如果IntCount=IntCount+100，则退出
如果结束
下一个
如果结束
其他的
’==什么也不做===
如果结束
端接头
'====在列表框中显示文件夹=====
'==在书本中显示文件夹项目====
'调用函数
显示FoldersInListBox folderpath&FCount&“quot&LCount，Me.Listbox1
子按钮\u单击（）
对于Folderpath&FCount&“\”&LCount&“\”&Listbox.value中的每个文件
“[插入大书代码]
下一个
端接头
私有子显示FoldersInListBox（ByVal strootFolder作为字符串，ByRef lbxDisplay作为MSForms.ListBox）
作为对象的Dim fso
作为对象的Dim fsoRoot
作为对象的模糊文件夹
'确保根文件夹包含尾部反斜杠
如果右$（strRootFolder，1）“\”则strRootFolder=strRootFolder&“\”
'获取对FileSystemObject的引用
设置fso=CreateObject（“Scripting.FileSystemObject”）
'获取根文件夹
设置fsoRoot=fso.GetFolder（strRootFolder）
“清除列表框
lbxDisplay，清除
'使用根目录的子文件夹填充列表框
对于fsoRoot.SubFolders中的每个fsoFolder
lbxDisplay.AddItem fsoFolder.Name
下一个F文件夹
“清理
设置fsoRoot=Nothing
设置fso=无
端接头

此链接： 似乎是应对文件的答案，但我不完全确定如何将其添加到我的脚本中。有人能帮我吗？

回到基本问题：

CopyXNumberOfFiles:Sub 用法 补遗 此函数将复制文件并返回新文件路径的数组

Function getCopyXNumberOfFiles(SourceFolder As String, TargetFolder As String, Optional MaxNumFiles As Long = 100) As String()
    Dim fso As Object, objFile As Object
    Dim count As Long, n As Long
    Dim Path As String
    Dim data() As String, results() As String
    ReDim data(1 To 2, 1 To MaxNumFiles)
    Set fso = CreateObject("Scripting.FileSystemObject")

    If Not Right(SourceFolder, 1) = "\" Then SourceFolder = SourceFolder & "\"
    If Not Right(TargetFolder, 1) = "\" Then TargetFolder = TargetFolder & "\"

    For Each objFile In fso.GetFolder(SourceFolder).Files
        If objFile.Path Like "*.xls?" Then
            Path = TargetFolder & objFile.Name
            If Len(Dir(Path)) = 0 Then
                FileCopy objFile.Path, Path
                count = count + 1
                data(1, count) = objFile.Path
                data(2, count) = Path
                If count >= MaxNumFiles Then Exit For
            End If
        End If
    Next
    ReDim Preserve results(1 To count, 1 To 2)
    For n = 1 To count
        results(n, 1) = data(1, n)
        results(n, 2) = data(2, n)
    Next
    getCopyXNumberOfFiles = results
End Function

用法 列1具有原始路径，列2具有新路径

原始路径

新路径

---

回答问题时，我通常会复制、粘贴和重构。当子例程的头丢失时，很难做到这一点。我编辑了OP的代码，使它更容易使用。当我阅读你的帖子时，我错过了一些东西。我更新了我的答案，只是按照你的要求去做。这样，我就可以在

For

语句中使用一个变量来获取第一个和最后一个文件名，创建文件夹，然后在文件达到100后移动文件。你能解释一下这部分吗？如果不正确（SourceFolder，1）=“\”那么SourceFolder=SourceFolder&“\”如果不正确（TargetFolder，1）=“\”那么TargetFolder=TargetFolder&“\”如果我将文件存储在一个数组中，是否可以对其进行数字排序？我的文件编号从1-1000，代码从“1,10,11,12,13,14…”开始，而不是“1,2,3,4,5,6…”等等。你能再帮我一次吗？@AnthonyCox我更新了我的答案，返回了一个文件名的2D数组。这会把100个文件放入一个数组，并在移动到文件夹之前对其进行数字排序吗？

 CopyXNumberOfFiles "C:\","C:\Data"

Function getCopyXNumberOfFiles(SourceFolder As String, TargetFolder As String, Optional MaxNumFiles As Long = 100) As String()
    Dim fso As Object, objFile As Object
    Dim count As Long, n As Long
    Dim Path As String
    Dim data() As String, results() As String
    ReDim data(1 To 2, 1 To MaxNumFiles)
    Set fso = CreateObject("Scripting.FileSystemObject")

    If Not Right(SourceFolder, 1) = "\" Then SourceFolder = SourceFolder & "\"
    If Not Right(TargetFolder, 1) = "\" Then TargetFolder = TargetFolder & "\"

    For Each objFile In fso.GetFolder(SourceFolder).Files
        If objFile.Path Like "*.xls?" Then
            Path = TargetFolder & objFile.Name
            If Len(Dir(Path)) = 0 Then
                FileCopy objFile.Path, Path
                count = count + 1
                data(1, count) = objFile.Path
                data(2, count) = Path
                If count >= MaxNumFiles Then Exit For
            End If
        End If
    Next
    ReDim Preserve results(1 To count, 1 To 2)
    For n = 1 To count
        results(n, 1) = data(1, n)
        results(n, 2) = data(2, n)
    Next
    getCopyXNumberOfFiles = results
End Function

Dim Files() as String, firstFilePath as String, lastFilePath as String

Files = getCopyXNumberOfFiles("C:\", "C:\New Folder\", 100)

firstFilePath  = Files(1, 1)
lastFilePath  = Files(Ubound(Files), 1)

firstFilePath  = Files(1, 2)
lastFilePath  = Files(Ubound(Files), 2)