Script for Retrieving Data

C

chinny

Afternoon Guys,

I'm trying to create a script that would allow me to retrieve data of
multiplies excel in any folder.

example. in folder A (c:\folder A\), there is 2 folder (B and D), each of
these folders have 5 excel spreadsheet in them. i want a script that will
collect information of all spreadsheet located in all folders under folder A.
The cell that the information is received from is cell,A1 on sheet
'Scorecard'. The current scrip that i have allows me to gather all
spreadsheet located in 1 folder, not several folders.

The script below is the one currently in use but is only limited to one
folder (A). I want to modify it so that it includes all the folder (B & D) in
that one folder (A) directory.

Sub get_data()

Dim fs, f, f1, fc
Dim row_num As Integer
Dim folder As String
Dim response As Integer
Dim Start As Single, Finish As Single, TotalTime As Single
Dim filename As String

folder = ActiveWorkbook.Path & "\"
row_num = 3

Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folder)
Set fc = f.Files
response = MsgBox("Collecting scorecards data may take some time. Please be
patient", vbOKCancel, "Continue?")

Sheets("Index").Range("H1").Value = 0
Sheets("Index").Range("I1").Value = 0

If (response = 1) Then
Start = Timer ' Set start time.

Sheets("Scorecard Data").Visible = True
Sheets("Scorecard Data").Select
Columns("GE:GG").Select
Selection.ClearContents
Sheets("Scorecard Data").Visible = True

Sheets("Scorecard Targets").Visible = True
Sheets("Scorecard Targets").Select
Columns("GE:GG").Select
Selection.ClearContents
Sheets("Scorecard Data").Visible = True


For Each f1 In fc
If (f1 <> ActiveWorkbook.Path & "\" & ActiveWorkbook.Name) Then
Sheets("Index").Range("I1").Value =
Sheets("Index").Range("I1").Value + 1
End If
Next
For Each f1 In fc
If (f1 <> ActiveWorkbook.Path & "\" & ActiveWorkbook.Name) Then
Sheets("Index").Range("H1").Value =
Sheets("Index").Range("H1").Value + 1

filename = f1.Name

Sheets("Scorecard Data").Range("GE" & row_num).Value = "='" & _
folder & "[" & filename & "]Scorecard'!A1"
Sheets("Scorecard Targets").Range("GE" & row_num).Value = "='" & _
folder & "[" & filename & "]Scorecard'!A2"
Sheets("Scorecard Target To Date").Range("GE" & row_num).Value =
"='" & _
folder & "[" & filename & "]Scorecard'!B2"
Sheets("Scorecard Data").Range("GG" & row_num).Value = folder &
filename

row_num = row_num + 1

End If
Next

row_num = 3

Finish = Timer ' Set end time.
TotalTime = Finish - Start ' Calculate total time.

MsgBox "" & Sheets("Index").Range("I1").Value & " Scorecards Gathered in " &
Round(TotalTime) & " seconds.", vbOKOnly, "Completed"

Sheets("Index").Range("E1").Value = Now

End If

End Sub
 
T

Tim

Typically you would do this using recursion

Eg (pseudocode/untested)

Sub StartHere()
ProcessFolders "C:\someinitalfolder"
End sub

Sub ProcessFolder(sPath)
set sht=thisworkbook.sheets("listing")
set fso=createobject("Scripting.FileSystemObject")
set fold=fso.GetFolder(sPath)

'get first unused row in col A
r=sht.Cells(sht.rows.count,1).end(xlup).row+1

for each f in fold.Files
'record details of f
sht.Cells(r,1).value=f.path
next f

'now call this procedure on each subfolder
for each sf in fold.subfolders
ProcessFolder fold.Path
next sf

end sub



Tim



chinny said:
Afternoon Guys,

I'm trying to create a script that would allow me to retrieve data of
multiplies excel in any folder.

example. in folder A (c:\folder A\), there is 2 folder (B and D), each of
these folders have 5 excel spreadsheet in them. i want a script that will
collect information of all spreadsheet located in all folders under folder
A.
The cell that the information is received from is cell,A1 on sheet
'Scorecard'. The current scrip that i have allows me to gather all
spreadsheet located in 1 folder, not several folders.

The script below is the one currently in use but is only limited to one
folder (A). I want to modify it so that it includes all the folder (B & D)
in
that one folder (A) directory.

Sub get_data()

Dim fs, f, f1, fc
Dim row_num As Integer
Dim folder As String
Dim response As Integer
Dim Start As Single, Finish As Single, TotalTime As Single
Dim filename As String

folder = ActiveWorkbook.Path & "\"
row_num = 3

Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folder)
Set fc = f.Files
response = MsgBox("Collecting scorecards data may take some time. Please
be
patient", vbOKCancel, "Continue?")

Sheets("Index").Range("H1").Value = 0
Sheets("Index").Range("I1").Value = 0

If (response = 1) Then
Start = Timer ' Set start time.

Sheets("Scorecard Data").Visible = True
Sheets("Scorecard Data").Select
Columns("GE:GG").Select
Selection.ClearContents
Sheets("Scorecard Data").Visible = True

Sheets("Scorecard Targets").Visible = True
Sheets("Scorecard Targets").Select
Columns("GE:GG").Select
Selection.ClearContents
Sheets("Scorecard Data").Visible = True


For Each f1 In fc
If (f1 <> ActiveWorkbook.Path & "\" & ActiveWorkbook.Name) Then
Sheets("Index").Range("I1").Value =
Sheets("Index").Range("I1").Value + 1
End If
Next
For Each f1 In fc
If (f1 <> ActiveWorkbook.Path & "\" & ActiveWorkbook.Name) Then
Sheets("Index").Range("H1").Value =
Sheets("Index").Range("H1").Value + 1

filename = f1.Name

Sheets("Scorecard Data").Range("GE" & row_num).Value = "='" & _
folder & "[" & filename & "]Scorecard'!A1"
Sheets("Scorecard Targets").Range("GE" & row_num).Value = "='" & _
folder & "[" & filename & "]Scorecard'!A2"
Sheets("Scorecard Target To Date").Range("GE" & row_num).Value =
"='" & _
folder & "[" & filename & "]Scorecard'!B2"
Sheets("Scorecard Data").Range("GG" & row_num).Value = folder &
filename

row_num = row_num + 1

End If
Next

row_num = 3

Finish = Timer ' Set end time.
TotalTime = Finish - Start ' Calculate total time.

MsgBox "" & Sheets("Index").Range("I1").Value & " Scorecards Gathered in "
&
Round(TotalTime) & " seconds.", vbOKOnly, "Completed"

Sheets("Index").Range("E1").Value = Now

End If

End Sub
Click to expand...
 
R

Ron de Bruin

hi chinny

See
http://www.rondebruin.nl/fso.htm


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


chinny said:
Afternoon Guys,

I'm trying to create a script that would allow me to retrieve data of
multiplies excel in any folder.

example. in folder A (c:\folder A\), there is 2 folder (B and D), each of
these folders have 5 excel spreadsheet in them. i want a script that will
collect information of all spreadsheet located in all folders under folder A.
The cell that the information is received from is cell,A1 on sheet
'Scorecard'. The current scrip that i have allows me to gather all
spreadsheet located in 1 folder, not several folders.

The script below is the one currently in use but is only limited to one
folder (A). I want to modify it so that it includes all the folder (B & D) in
that one folder (A) directory.

Sub get_data()

Dim fs, f, f1, fc
Dim row_num As Integer
Dim folder As String
Dim response As Integer
Dim Start As Single, Finish As Single, TotalTime As Single
Dim filename As String

folder = ActiveWorkbook.Path & "\"
row_num = 3

Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folder)
Set fc = f.Files
response = MsgBox("Collecting scorecards data may take some time. Please be
patient", vbOKCancel, "Continue?")

Sheets("Index").Range("H1").Value = 0
Sheets("Index").Range("I1").Value = 0

If (response = 1) Then
Start = Timer ' Set start time.

Sheets("Scorecard Data").Visible = True
Sheets("Scorecard Data").Select
Columns("GE:GG").Select
Selection.ClearContents
Sheets("Scorecard Data").Visible = True

Sheets("Scorecard Targets").Visible = True
Sheets("Scorecard Targets").Select
Columns("GE:GG").Select
Selection.ClearContents
Sheets("Scorecard Data").Visible = True


For Each f1 In fc
If (f1 <> ActiveWorkbook.Path & "\" & ActiveWorkbook.Name) Then
Sheets("Index").Range("I1").Value =
Sheets("Index").Range("I1").Value + 1
End If
Next
For Each f1 In fc
If (f1 <> ActiveWorkbook.Path & "\" & ActiveWorkbook.Name) Then
Sheets("Index").Range("H1").Value =
Sheets("Index").Range("H1").Value + 1

filename = f1.Name

Sheets("Scorecard Data").Range("GE" & row_num).Value = "='" & _
folder & "[" & filename & "]Scorecard'!A1"
Sheets("Scorecard Targets").Range("GE" & row_num).Value = "='" & _
folder & "[" & filename & "]Scorecard'!A2"
Sheets("Scorecard Target To Date").Range("GE" & row_num).Value =
"='" & _
folder & "[" & filename & "]Scorecard'!B2"
Sheets("Scorecard Data").Range("GG" & row_num).Value = folder &
filename

row_num = row_num + 1

End If
Next

row_num = 3

Finish = Timer ' Set end time.
TotalTime = Finish - Start ' Calculate total time.

MsgBox "" & Sheets("Index").Range("I1").Value & " Scorecards Gathered in " &
Round(TotalTime) & " seconds.", vbOKOnly, "Completed"

Sheets("Index").Range("E1").Value = Now

End If

End Sub
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Command Button to import worksheets 2
Failed to add footer one of work sheet, Thanks 3
Looping Macro - Run Time Error 4
move data from one spreadsheet to another and repeat 1
Filter and copy data to other sheet 3
fill several sheets with data from other workbooks matching criter 0
Help with error 53 8
Update existing data or Insert new problem 3

Top