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?
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 SubAnswer1:
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
.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 SubAnswer2:
If I get this right you need a function which collects all xl files in a directory and subdirs. This function will do that:
Public Function RecursiveDir(colFiles As Collection, _ strFolder As String, _ strFileSpec As String, _ bIncludeSubfolders As Boolean) Dim strTemp As String Dim colFolders As New Collection Dim vFolderName As Variant 'Add files in strFolder matching strFileSpec to colFiles strFolder = TrailingSlash(strFolder) strTemp = Dir(strFolder & strFileSpec) Do While strTemp <> vbNullString colFiles.Add strFolder & strTemp strTemp = Dir Loop If bIncludeSubfolders Then 'Fill colFolders with list of subdirectories of strFolder strTemp = Dir(strFolder, vbDirectory) Do While strTemp <> vbNullString If (strTemp <> ".") And (strTemp <> "..") Then If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0 Then colFolders.Add strTemp End If End If strTemp = Dir Loop 'Call RecursiveDir for each subfolder in colFolders For Each vFolderName In colFolders Call RecursiveDir(colFiles, strFolder & vFolderName, strFileSpec, True) Next vFolderName End If End Function Public Function TrailingSlash(strFolder As String) As String If Len(strFolder) > 0 Then If Right(strFolder, 1) = "\" Then TrailingSlash = strFolder Else TrailingSlash = strFolder & "\" End If End If End Function
And this shows how to use it
Sub TesterFiles() Dim colFiles As New Collection RecursiveDir colFiles, "Your Dir goes here...", "*.XLS*", True Dim vFile As Variant For Each vFile In colFiles ' Do sth with the file Debug.Print vFile Next vFile End SubAnswer3:
Nice one Storax! I would use the script that Storax posted, and modify it just a tad.
i = 1 Dim vFile As Variant For Each vFile In colFiles ' Do sth with the file Range("A" & i).Value = vFile i = i + 1 Next vFile
I think it's just easier to work with a list. Anyway, once you have the file structure, you can run through those elements in the array you just created. Use the script below to do that.
Sub LoopThroughRange() Dim rng As Range, cell As Range Set rng = Range("A1:A13") For Each cell In rng 'For Fnum = LBound(MyFiles) To UBound(MyFiles) Set mybook = Nothing On Error Resume Next Set mybook = Workbooks.Open(cell) On Error GoTo 0 If Not mybook Is Nothing Then 'Change cell value(s) in one worksheet in mybook On Error Resume Next With mybook.Worksheets(1) If .ProtectContents = False Then .Range("A1").Value = "My New Header" Else ErrorYes = True End If End With If Err.Number > 0 Then ErrorYes = True Err.Clear 'Close mybook without saving mybook.Close savechanges:=False Else 'Save and close mybook mybook.Close savechanges:=True End If On Error GoTo 0 Else 'Not possible to open the workbook ErrorYes = True End If 'Next Fnum Next cell End Sub
The idea comes straight from here.
<a href="http://www.rondebruin.nl/win/s3/win010.htm" rel="nofollow">http://www.rondebruin.nl/win/s3/win010.htm</a>
<strong>Pay attention to this part: 'Change cell value(s) in one worksheet in mybook That's where you want to put specific your code to do exactly what you want to do.</strong>
I just modified my OP. It's a lot easier, and a little different, than I initially made it out to be. I've adjusted the script accordingly.