时间戳

首页 > 解决方案 > 使用 VBA 遍历两个不同的目录

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

问题描述

我想遍历来自两个不同目录的所有文件。问题是如果我想在两个文件夹上同时使用 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 没有任何了解，因此任何有关修改此简单代码的提示都会非常有帮助。

标签： excelvba

解决方案

我有这个工作。我有一个名为“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

推荐阅读