如何根据第一个和最后一个文件名将 100 个文件复制到一个文件夹并在列表框中显示 vba
How to copy 100 files to a folder based on first and last file name and display in listbox vba
我正在尝试编写一段脚本，允许我从一个文件夹复制 100 个文件并根据第一个文件和最后一个文件名创建一个新文件夹，然后将这 100 个文件移动到该文件夹。
移动这些文件后，我希望它将用户窗体列表框中的文件夹显示为可点击的项目。
例如，列表框中的每个项目都是一个文件夹，如果我双击文件夹名称，它将在我设置的 sheet 中显示文件的所有内容（100 个文件中的每一个）。
我还不能测试这段代码，过去一周我所做的就是反复研究和重写代码，直到我能正确理解它，然后再将它添加到程序中。所以在这个过程中肯定会有一些或更多的错误。
我注意到的是 "objFile.CopyFile Folderpath & FCount & "_" & 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
这个link：Copy only the first file of a folder VBA
似乎是处理文件的答案，但我不完全确定如何将它添加到我的脚本中。谁能帮帮我？
回归基础：
CopyXNumberOfFiles:子
Sub CopyXNumberOfFiles(SourceFolder As String, TargetFolder As String, Optional MaxNumFiles As Long = 100)
Dim fso As Object, objFile As Object
Dim count As Long
Dim Path As String
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
If count >= MaxNumFiles Then Exit For
End If
End If
Next
End Sub
用法
CopyXNumberOfFiles "C:\","C:\Data"
附录
此函数将复制文件和 return 新文件路径数组。
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 列包含新路径。
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)
我正在尝试编写一段脚本，允许我从一个文件夹复制 100 个文件并根据第一个文件和最后一个文件名创建一个新文件夹，然后将这 100 个文件移动到该文件夹。 移动这些文件后，我希望它将用户窗体列表框中的文件夹显示为可点击的项目。 例如，列表框中的每个项目都是一个文件夹，如果我双击文件夹名称，它将在我设置的 sheet 中显示文件的所有内容（100 个文件中的每一个）。
我还不能测试这段代码，过去一周我所做的就是反复研究和重写代码，直到我能正确理解它，然后再将它添加到程序中。所以在这个过程中肯定会有一些或更多的错误。
我注意到的是 "objFile.CopyFile Folderpath & FCount & "_" & 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
这个link：Copy only the first file of a folder VBA 似乎是处理文件的答案，但我不完全确定如何将它添加到我的脚本中。谁能帮帮我？
回归基础：
CopyXNumberOfFiles:子
Sub CopyXNumberOfFiles(SourceFolder As String, TargetFolder As String, Optional MaxNumFiles As Long = 100)
Dim fso As Object, objFile As Object
Dim count As Long
Dim Path As String
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
If count >= MaxNumFiles Then Exit For
End If
End If
Next
End Sub
用法
CopyXNumberOfFiles "C:\","C:\Data"
附录
此函数将复制文件和 return 新文件路径数组。
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 列包含新路径。
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)