在文件夹中的所有目录上运行excel宏递归等等 [英] Run excel macro recursive on all directories inside of a folder and so on

问题描述

我有一个文件夹，我有很多子文件夹，其中的内容超过1000个excel文件，我想运行一个特定的宏（改变的东西在wb）在所有的1000个文件和子文件夹？
已经为这个问题（VBA），
播下了以下答案，但答案有两个问题，
1.这个解决方案会非常慢，有更快的方法吗？可能不是..
2.这个宏只会运行在匹配文件夹中的文件中，而不是所有子文件夹中的文件，
有没有办法为子文件夹中的文件好吧？

VBA：

  Sub ProcessFiles（）
 Dim Filename，Pathname As String 
 Dim wb As Workbook 
 
 Pathname = ActiveWorkbook.Path& \C：\ ... \EXCL\
文件名=目录（路径名&* .xlsx）
尽管文件名<> 
设置wb = Workbooks.Open（路径名和文件名）
 DoWork wb 
 wb.Close SaveChanges：= True 
文件名= Dir（）
循环
 End Sub 
 
 Sub DoWork（wb As Workbook）
 with wb 
'你的工作在这里
 ...... 
结束
 End Sub 
  

解决方案

就我而言知道，VBA无法编辑衣柜工作簿。如果您想为每个子文件夹中的每个工作簿进行工作，子文件夹子文件夹等都可以使用以下代码。我添加了条件，它必须是 .xlsx 文件，您可以在 .xls ， .xlsb 或任何你想要的。

  Sub ProcessFiles（）
 Dim objFolder As Object 
 Dim objFile As Object 
 Dim objFSO作为对象
 Dim MyPath As String 
 Dim myExtension As String 
 Dim FldrPicker As FileDialog 
 
设置FldrPicker = Application.FileDialog（msoFileDialogFolderPicker）
 
使用FldrPicker 
 .Title =选择目标文件夹
 .AllowMultiSelect = False 
如果.Show<> -1然后GoTo EmptyEnd 
 MyPath = .SelectedItems（1）
结束
 
 Application.ScreenUpdating = False 
设置objFSO = CreateObject（Scripting.FileSystemObject） 
调用GetAllFiles（MyPath，objFSO）
调用GetAllFolders（MyPath，objFSO）
 Application.ScreenUpdating = True 
 
 MsgBoxComplete。 
 
 EmptyEnd：
 End Sub 
 
 Sub GetAllFiles（ByVal strPath As String，ByRef objFSO As Object）
 Dim objFolder As Object 
 Dim objFile As Object 
 
设置objFolder = objFSO.GetFolder（strPath）
对于每个objFile在objFolder.Files 
 DoWork objFile.Path 
下一个objFile 
结束Sub 
 
 Sub GetAllFolders（ByVal strFolder As String，ByRef objFSO As Object）
 Dim objFolder As Object 
 Dim objSubFolder As Object 
 
 Set objFolder = objFSO 。$ Get $（$）
调用GetAllFolders（objSubFolder.Path，objFSO）
对于每个objSubFolder，objFolder.subfolders 
调用GetAllFiles（objSubFolder.Path，objFSO）
下一个objSubFolder 
 End Sub 
 
 Sub DoWork（strFile As String）
 Dim wb As Workbook 
如果右（strFile，4）=xlsx然后
设置wb = Workbooks.Open（文件名：= strFile）
用wb 
'你的工作在这里
 ...... 
。关闭True 
 End with 
 End If 
 End Sub 
  

I have a folder where I have many sub-folders and inside of them more then 1000 excel files, I want to run a specific macro (that changed things in wb) on all 1000 files and sub folders? already sow the following answer for that issue (on VBA), but there is two problem with that answer, 1. this solution will be extremely slow, is there a faster way? maybe not.. 2. this macro will only run in the files on the matching folder and not into the files in all sub-folders, Is there way to do that for files in sub-folders as well?

VBA:

Sub ProcessFiles()
    Dim Filename, Pathname As String
    Dim wb As Workbook

    Pathname = ActiveWorkbook.Path & "\C:\...\EXCL\"
    Filename = Dir(Pathname & "*.xlsx")
    Do While Filename <> ""
        Set wb = Workbooks.Open(Pathname & Filename)
        DoWork wb
        wb.Close SaveChanges:=True
        Filename = Dir()
    Loop
End Sub

Sub DoWork(wb As Workbook)
    With wb
        'Do your work here
        ......
    End With
End Sub

解决方案

As far as I know, VBA can't edit closet workbook. If you want to do work for every workbook in every subfolder, subfolder of subfolder etc. you can use the following code. I added condition, that it have to be .xlsx file, you can change it on .xls, .xlsb or whatever you want.

Sub ProcessFiles()
Dim objFolder As Object
Dim objFile As Object
Dim objFSO As Object
Dim MyPath As String
Dim myExtension As String
Dim FldrPicker As FileDialog

    Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
        .Title = "Select A Target Folder"
        .AllowMultiSelect = False
        If .Show <> -1 Then GoTo EmptyEnd
        MyPath = .SelectedItems(1)
    End With

    Application.ScreenUpdating = False
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Call GetAllFiles(MyPath, objFSO)
    Call GetAllFolders(MyPath, objFSO)
    Application.ScreenUpdating = True

    MsgBox "Complete."

EmptyEnd:
End Sub

Sub GetAllFiles(ByVal strPath As String, ByRef objFSO As Object)
Dim objFolder As Object
Dim objFile As Object

    Set objFolder = objFSO.GetFolder(strPath)
    For Each objFile In objFolder.Files
            DoWork objFile.Path
    Next objFile
End Sub

Sub GetAllFolders(ByVal strFolder As String, ByRef objFSO As Object)
Dim objFolder As Object
Dim objSubFolder As Object

    Set objFolder = objFSO.GetFolder(strFolder)
    For Each objSubFolder In objFolder.subfolders
        Call GetAllFiles(objSubFolder.Path, objFSO)
        Call GetAllFolders(objSubFolder.Path, objFSO)
    Next objSubFolder
End Sub

Sub DoWork(strFile As String)
Dim wb As Workbook
    If Right(strFile, 4) = "xlsx" Then
        Set wb = Workbooks.Open(Filename:=strFile)
        With wb
            'Do your work here
            ......
            .Close True
        End With
    End If
End Sub

这篇关于在文件夹中的所有目录上运行excel宏递归等等的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！