使用VBA將1300個隨機25個文件復制到另一個文件夾

Question

我在服務器上有1300個excel文件，其中包含收入。 我需要將這些收入與一個數據透視文件進行比較，以確保實際2個文件中的收入相同。 因為它在服務器上，所以從服務器打開所有文件都非常慢，這就是為什么我要首先將它們的一個樣本（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集合-對象給出了該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

您的任務的可能解決方案是：

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