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。目标和源Excel都具有相同的名称（以便于使用）。

我对VBA没有任何了解，因此有关修改此简单代码的任何提示将非常有帮助。

Answer 1

我已经开始工作了。我有一个名为“ DirectoryLooper”的类。这将分别为每个文件夹执行目录，并进行比较。代码中也存在一个缺陷，即文件夹中文件的数量不同。然后，当文件较少的文件夹到达最后一个文件时，您的代码和我的代码都将终止。

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

使用VBA遍历两个不同的目录

1 个答案: