Проход по двум разным каталогам с использованием VBA

Question

Я хочу перебрать все файлы из двух разных каталогов.Проблема в том, что функция DIR не работает должным образом, если я хочу использовать ее одновременно на двух папках.Это мой код:

Sub LoopThroughAllFiles()

Dim wb2 As Workbook
Dim wb As Workbook
Dim mySourcePath As String
Dim mySourceFile As String
Dim myDestinationPath As String
Dim myDestinationFile As String

'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

'Retrieve Target Folder Path From User
  mySourcePath = "C:\Source\"
  myDestinationPath = "C:\Destination\"
  prefix = "target_"

  mySourcePath = mySourcePath
  myDestinationPath = myDestinationPath

  If mySourcePath = "" Then GoTo ResetSettings
  If myDestinationPath = "" Then GoTo ResetSettings

'Target Path with Ending Extention
  mySourceFile = Dir(mySourcePath)
  myDestinationFile = Dir(myDestinationPath)

'Loop through each Excel file in folder
  Do While mySourceFile <> "" And myDestinationFile <> ""
'Set variable equal to opened workbook
  Set wb = Workbooks.Open(Filename:=mySourcePath & mySourceFile)
  Set wb2 = Workbooks.Open(Filename:=myDestinationPath & myDestinationFile)
'Ensure Workbook has opened before moving on to next line of code
  DoEvents


'Save and Close Workbook
 wb.Close SaveChanges:=True
 wb2.Close SaveChanges:=True

'Ensure Workbook has closed before moving on to next line of code
  DoEvents

'Get next file name
  mySourceFile = Dir
  myDestinationFile = Dir
  Loop

ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

Идея состоит в том, что я хочу скопировать один лист из исходного Excel в целевой файл Excel.Это для каждого Excel в исходной и целевой папке.Имена получателя и источника имеют одно и то же имя (чтобы было проще).

У меня нет никаких знаний о VBA, поэтому любая подсказка об изменении этого простого кода будет очень полезной.

Answer 1

У меня это работает.У меня есть класс с именем "DirectoryLooper".Это выполняет Dir для каждой папки отдельно и делает сравнение ранее.Единственный недостаток в этом, который также существует в вашем коде, - это если файлы имеют разное количество файлов.Тогда и ваш код, и мой код прекратят работу, когда папка с меньшим количеством файлов попадет в последний файл.

Private FilePath_ As String
Private fileArray() As String
Private fileIndex As Long

Public Property Let FilePath(ByVal FilePath As String)
    FilePath_ = FilePath
End Property
Public Property Get FilePath() As String
    FilePath = FilePath_
End Property
Public Property Get NumberFiles() As String
    NumberFiles = fileIndex
End Property

Public Sub SetDir()
    Dim fileLoop As String

    fileIndex = 0
    fileLoop = Dir(FilePath_)

    Do While fileLoop <> ""
        ReDim Preserve fileArray(0 To fileIndex) As String
        fileArray(fileIndex) = fileLoop
        fileIndex = fileIndex + 1
        fileLoop = Dir
    Loop
End Sub

Public Function ReturnFile(ndxOfFiles As Long)
    ReturnFile = fileArray(ndxOfFiles)
End Function

Затем в главном модуле приведены соответствующие части вашего кода с моими дополнениями.

Sub LoopThroughAllFiles()
    Dim wb As Workbook
    Dim wb2 As Workbook
    Dim dirOne As DirectoryLooper
    Dim dirTwo As DirectoryLooper
    Dim ndxFiles As Long
    Dim ndxCount As Long

    Set dirOne = New DirectoryLooper
    Set dirTwo = New DirectoryLooper

    dirOne.FilePath = "C:\SourceFolder\"
    dirTwo.FilePath = "C:\DestinationFolder\"

    dirOne.SetDir
    dirTwo.SetDir

    If dirOne.NumberFiles < dirTwo.NumberFiles Then
         ndxCount = dirOne.NumberFiles - 1
    Else
         ndxCount = dirTwo.NumberFiles - 1
    End If

    ndxFiles = 0
    Do While ndxFiles <= ndxCount

        Set wb = Workbooks.Open(Filename:=dirOne.FilePath & dirOne.ReturnFile(ndxFiles))
        Set wb2 = Workbooks.Open(Filename:=dirTwo.FilePath & dirTwo.ReturnFile(ndxFiles))

        DoEvents

        wb.Close SaveChanges:=True
        wb2.Close SaveChanges:=True

        DoEvents

        ndxFiles = ndxFiles + 1
    Loop
End Sub