使用VBA将随机25个文件从1300复制到另一个文件夹

Question

我在服务器上有1300个excel文件，其中包含收入。我需要将这些收入与一个数据透视文件进行比较，以确保实际2个文件中的收入相同。因为它在服务器上，从服务器打开所有这些将是非常慢的，这就是为什么我想首先将它们的样本（25个excel文件）复制到我的compter，然后从该文件夹运行我的比较宏。但我想让复制过程自动化，所以我不知何故需要随机选择其中的25个文件，然后将其复制到另一个文件夹中。我有一个代码将所有文件从一个文件夹复制到另一个文件夹，但我需要随机选择它。谢谢。

 Sub Copy_Folder()

 Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String
FromPath = "C:\Users\NagyI2\Documents\Macro testing"
ToPath = "C:\Users\NagyI2\Documents\Copy test"

If Right(FromPath, 1) = "\" Then
    FromPath = Left(FromPath, Len(FromPath) - 1)
End If

If Right(ToPath, 1) = "\" Then
    ToPath = Left(ToPath, Len(ToPath) - 1)
End If

Set FSO = CreateObject("scripting.filesystemobject")

If FSO.FolderExists(FromPath) = False Then
    MsgBox FromPath & " doesn't exist"
    Exit Sub
End If

FSO.CopyFolder Source:=FromPath, Destination:=ToPath

End Sub

Answer 1

files-collection的folder集合提供了该文件夹中的文件列表。但是，您无法通过索引访问其中一个文件，只能按名称访问。因此，以下代码首先创建一个包含所有文件名称的数组。然后，在第二个循环中，随机创建文件索引，并将文件复制到目标文件夹。

Dim FSO As Object, folder a Object, file as Object
Set folder = fso.GetFolder(FromPath)
Dim fList() As String, i As Long
ReDim fList(1 To folder.Files.Count)

For Each file In folder.Files
    i = i + 1
    fList(i) = file.Name
Next file

Dim copyCount As Long, fIndex As Long
copyCount = 0
Do While copyCount < 25 And copyCount < folder.Files.Count
    fIndex = Int(Rnd * folder.Files.Count) + 1
    If fList(fIndex) <> "" Then
        Set file = folder.Files(CStr(fList(fIndex)))
        file.Copy ToPath, True
        fList(fIndex) = ""    '  Mark this file as copied to prevent that it is picked a 2nd time
        copyCount = copyCount + 1
    End If
Loop

Answer 2

您的任务的可能解决方案是：

1. 读取数组中FromPath中的所有文件名。
2. 在具有25次运行的循环中，基于阵列的长度生成随机数。
3. 确保您没有复制已复制的文件。

Answer 3

它必须非常快

Sub CopyFiles()
    Dim objRows() As String
    Dim fso As Object
    Dim randNum As Long
    Source = "C:\Users\NagyI2\Documents\Macro testing\"
    Destination = "C:\Users\NagyI2\Documents\Copy test\"
    randNum = 25 ' set random number
        results = CreateObject("WScript.Shell").Exec("CMD /C DIR """ & Source & "*.xls*"" /S /B /A:-D").StdOut.ReadAll ' get file list in Source
        objRows = Split(results, vbCrLf) ' move list to array
        ReDim Preserve objRows(UBound(objRows) - 1) ' trim last empty value
        sList = getRand(randNum, objRows) ' get randomized list
            Set fso = VBA.CreateObject("Scripting.FileSystemObject")
                For Each sFile In sList
                    Call fso.CopyFile(sFile, Destination, True) ' copy randomized files
                Next sFile
End Sub

Function getRand(rKey As Long, sArr As Variant) As Variant
    Randomize
    Set dict = CreateObject("Scripting.Dictionary")
    upperbound = UBound(sArr) 
    lowerbound = LBound(sArr)
    If rKey > upperbound Then getRand = sArr: Exit Function
    For i = 1 To rKey
        key = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
        If Not dict.Exists(key) Then dict.Add key, sArr(key) Else i = i - 1
    Next i
    getRand = dict.Items
End Function