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

Question

I have 1300 excel files on a server, with revenues in them. I need to compare these revenues with one pivot file to make sure the revenues are the same in the actual 2 files. Because it is on a server, opening all of them from a server would be pretty slow, thats why I want to copy a sample of them (25 excel files) to my compter first, and then run my comparison macro from this folder. But I want to make the copying process automatized, so I somehow need to select randomly 25 of these files, and then copy it to an other folder. I have a code to copy all of the files from one folder to another, but I need the random selection to it. Thanks.

 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

The files -collection of a folder -object gives a list of files in that folder. However, you cannot access to one of the files by index, just by name. So the following code creates first an array with the names of all files. Then, in a second loop, a file index is created by random, and the file is copied to the destination 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

A possible solution for your task is:

1. Read all filenames in FromPath in an array.
2. In a loop with 25 runs generate a random number based on the length of the array.
3. Ensure that you did not copy by chance a file you already have copied.

Answer 3

it must be very fast

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