Скопируйте случайные 25 файлов из 1300 в другую папку с VBA

Question

У меня есть 1300 файлов Excel на сервере с доходами в них. Мне нужно сравнить эти доходы с одним сводным файлом, чтобы убедиться, что доходы совпадают с фактическими двумя файлами. Поскольку он находится на сервере, все они открываются с сервера довольно медленно, поэтому я хочу сначала скопировать их образец (25 файлов Excel) в мой компьютер, а затем запустить мой макрос сравнения из этой папки. Но я хочу автоматизировать процесс копирования, поэтому мне нужно как-то случайно выбрать 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 объекта 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

должно быть очень быстро

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

Answer 3

Возможное решение для вашей задачи:

1. Чтение всех имен файлов в FromPath в массиве.
2. В цикле с 25 запусками генерируется случайное число на основе длины массива.
3. Убедитесь, что вы случайно не скопировали уже скопированный файл.