如何使用数组访问VBA中文件夹中的文件？

Question

这段代码有些麻烦。 实际上，它旨在通过循环目录/文件夹中的所有文件，将值分配给dir1array（ctr1）和dir2array（ctr2）； 有没有办法使这个数组工作？

Option Explicit

'*********************************************************************
'* Verify if files have the same name before proceeding to compare   *
'* their  length                                                     *
'*                     DYNAMIC ARRAYs                                *
'*********************************************************************

Sub findMatchFilenames()

    'Dim fso As fileSystemObject
    Dim objMapinfo
    Dim fso As New Scripting.FileSystemObject
    Dim dir1 As Folder
    Dim dir2 As Folder
    Dim file1 As File
    Dim file2 As File
    Dim dir1array() As String
    Dim dir2array() As String
    ReDim dir1array(0 To 100) As String
    ReDim dir2array(0 To 100) As String
    Dim ctr1 As Integer
    Dim ctr2 As Integer
    Dim lLen1 As Long, lLen2 As Long
    Dim myFile As String, text As String, textline As String

    Set fso = New FileSystemObject
    Set dir1 = fso.GetFolder("c:\Temp\")
    Set dir2 = fso.GetFolder("c:\Tempo\")


    ctr1 = 0
    For Each file1 In dir1.Files
      ctr2 = 0
      For Each file2 In dir2.Files

       dir1array(ctr1) = file1.Name
       dir2array(ctr2) = file2.Name
       If dir1array(ctr1) = dir2array(ctr2) Then
            MsgBox "" & dir1array(ctr1) & "" & dir2array(ctr2)
            Debug.Print file1.Name & " matches " & file2.Name
            lLen1 = FileLen(file1)
            lLen2 = FileLen(file2)
                If lLen1 <> lLen2 Then
                    Exit Sub
                Else
                MsgBox "The files have the same length"               
            End If
        End If

      ctr2 = ctr2 + 1
     Next file2
      ctr1 = ctr1 + 1

     Next file1

    Close #1
End Sub

Answer 1

以下是代码的变体，但不使用数组。

Option Explicit

Sub findMatchFilenames()
Dim lLen1       As Long
Dim lLen2       As Long

Dim oFSO        As New Scripting.FileSystemObject
Dim dir1        As Folder
Dim dir2        As Folder
Dim oFile1      As File
Dim oFile2      As File
Dim strFolder1  As String
Dim strFolder2  As String

    Close #1    ' I always close first when testing (in case I don't get to normal close)
    Close #2
    Open "C:\Temp\" & Format(Now(), "_SAME_yyyy-mm-dd_hh-mm") & ".txt" For Output As #1
    Open "C:\Temp\" & Format(Now(), "_Different_yyyy-mm-dd_hh-mm") & ".txt" For Output As #2

    Set oFSO = New FileSystemObject
    strFolder1 = "c:\Temp\"
    strFolder2 = "c:\Tempo\"

    Set dir1 = oFSO.GetFolder(strFolder1)
    Set dir2 = oFSO.GetFolder(strFolder2)

    For Each oFile1 In dir1.Files
        If oFSO.FileExists(strFolder2 & oFile1.Name) Then        ' If it matches same name
            Set oFile2 = oFSO.GetFile(strFolder2 & oFile1.Name)
            If oFile1.Size = oFile2.Size Then
                Print #1, oFile1.Name & vbTab & "File found in both folders; Size is the same;"
                Debug.Print oFile1.Name & vbTab & "File found in both folders; Size is the same;"
            Else
                Print #1, oFile1.Name & vbTab & "Found in both folders; Size is DIFFERENT; " & oFile1.Size & " vs: " & oFile2.Size
                Debug.Print oFile1.Name & vbTab & "Found in both folders; Size is DIFFERENT; " & oFile1.Size & " vs: " & oFile2.Size
            End If
        Else                ' Same file not found.
            Debug.Print "File not present in 2nd folder: " & oFile1.Name
            Print #1, oFile1.Name & vbTab & "File NOT found in second folder;"
        End If

    Next oFile1
    Set oFile1 = Nothing
    Set oFile2 = Nothing
    Set oFSO = Nothing

    Close #1
    Close #2

End Sub