PDA

View Full Version : Open all Excell files in subfolders without specifying Name of Files



afzalw
07-04-2012, 12:24 AM
I found this code which open specified multi excel files from specified folders and extract data from them. How can I change it so I don`t have to specify the name of sub folder and excel files, instead it ran code on all excel files in subfolders.

Thanks

Sub CopySourceValuesToDestinationEdited3()

Dim wbDest As Workbook
Dim wbSource As Workbook
Dim sDestPath As String
Dim sSourcePath As String
Dim shDest As Worksheet
Dim rDest As Range
Dim vaFolder As Variant
Dim vaFiles As Variant
Dim i As Long

'array of folder names under sDestPath
vaFolder = Array("ABC", "DEF", "GHI", "JKL")

'array of file names under the respective folders in vaFolder
vaFiles = Array("ABCFile.xls", "DEFFile.xls", "GHIFile.xls", "JKLFile.xls")

sDestPath = "D:\A\"
sSourcePath = "D:\A\"

'Open the destination workbook at put the destination sheet in a variable
Set wbDest = Workbooks.Open(sDestPath & "a.xlsx")
Set shDest = wbDest.Sheets(1)

'loop through the folders
For i = LBound(vaFolder) To UBound(vaFolder)
'open the source
Set wbSource = Workbooks.Open(sSourcePath & vaFolder(i) & "\" & vaFiles(i))
' Rest of the code for extracting data

GTO
07-04-2012, 04:58 AM
A stab. Error handling is just worthless.

Maybe a start though at your desire to recursively run through the folders.

Option Explicit

Sub Main()
Dim FSO As Object ' FileSystemObject
Dim fsoFol As Object ' Folder
Dim fsoFil As Object ' File
Dim SomeVal As Double

Set FSO = CreateObject("Scripting.FileSystemObject")
'// However you want to set an initial folder... //
Set fsoFol = FSO.GetFolder(ThisWorkbook.Path)

Application.Calculation = xlCalculationManual
'// For the rather rudimentary example, I just chose to loop through workbooks and //
'// pass the value (if numeric) from cell A1 on the first sheet. //
Call RecurseIt(FSO, fsoFol, SomeVal)
Application.Calculation = xlCalculationAutomatic

If SomeVal > 0 Then
MsgBox SomeVal
End If
End Sub

' .. As FileSystemObject, ... as Folder
Function RecurseIt(fs As Object, fsoFolder As Object, MyVal As Double)
Dim fsoFile As Object ' File
Dim fsoFol As Object ' Folder
Dim wb As Workbook
Dim ws As Worksheet

For Each fsoFile In fsoFolder.Files
'// "Extra" test, as I chose root on thisworkbook.Path //
If Not fsoFile.Path = ThisWorkbook.FullName Then
'// Maybe a pattern, if different versions need opened. //
If Mid(fsoFile.Name, InStrRev(fsoFile.Name, ".")) Like ".xls*" Then
Set wb = Workbooks.Open(fsoFile.Path, , True)
'// YOur code to get whatever values... //
Set ws = wb.Worksheets(1)
If IsNumeric(ws.Cells(1).Value) And Not ws.Cells(1).Value = vbNullString Then
MyVal = MyVal + ws.Cells(1).Value
End If

'// The name is a hint; it did not help when I ran into a previous //
'// download from an OP, in which the BeforeClose produced an error... //
On Error GoTo DangIt
wb.Close False
On Error GoTo 0
End If
End If
Next

'// Recurse //
For Each fsoFol In fsoFolder.SubFolders
Call RecurseIt(fs, fsoFol, MyVal)
Next
Exit Function
DangIt:
MsgBox fsoFile.Path
End Function

Hope that helps a little at least,

Mark

snb
07-04-2012, 06:49 AM
to get all Excel files in directory G:\OF and all of it's subfolders:

sub snb()
c00="G:\OF\*.xls"

sn=application.transpose(split(createobject("wscript.shell").exec("cmd /c Dir " & c00 & " /b /s").stdout.readall,vbcrlf))
cells(1).resize(ubound(sn))=sn
end sub

afzalw
07-04-2012, 05:27 PM
to get all Excel files in directory G:\OF and all of it's subfolders:

sub snb()
c00="G:\OF\*.xls"

sn=application.transpose(split(createobject("wscript.shell").exec("cmd /c Dir " & c00 & " /b /s").stdout.readall,vbcrlf))
cells(1).resize(ubound(sn))=sn
end sub


Thanks, that help me get one step further. Now how can I change the following array to read file path from first column of this workbook.

'array of file names under the respective folders in vaFolder
vaFiles = Array("ABCFile.xls", "DEFFile.xls", "GHIFile.xls", "JKLFile.xls")