LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #5   Report Post  
Junior Member
 
Posts: 21
Default

Quote:
Originally Posted by Royzer View Post
Thank you, Bruno. I will try this when I return to work Thursday.

Roy
Bruno, my apologies for taking so long to try your code. If you do not wish to pursue this after all this time has passed, I understand.

The code on the second line "Dim FS As New FileSystemObject"
is giving me a "user defined type not defined" error:

These two lines under "CheckFileName" are showing in red when I paste the code:

Set SourceRange =

and

TargetRange(n + NumRow * (h - 1), m) = SourceRange(n,
m)




[code]
Public Sub CollectFromEverywhere()
Dim FS As New FileSystemObject
Dim FS_subFolders As Object
Dim FS_Folders As Object, SourceFile As Object
Dim FS_Files As Object, xlApp As New Excel.Application
Dim colFolders_1 As Collection, SourceRange As Range
Dim colFolders_2 As Collection, n As Long, m As Long
Dim i, j, k, h As Long, NumRow As Integer, NumCol As Integer
Dim TargetRange As Range, SourceFolder As String

' Definitions ---------------------------
SourceFolder = "S:\Accounting\film"
NumRow = 100
NumCol = 8
Set TargetRange = [MasterSheet!A1]
' ---------------------------------------

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Set colFolders_1 = New Collection
colFolders_1.Add SourceFolder
On Error GoTo FolderNotFound
Set FS_Folders = FS.GetFolder(SourceFolder)
On Error GoTo 0
Set FS_Files = FS_Folders.Files
For Each k In FS_Files
GoSub CheckFileName
Next

Start:
'------
Set colFolders_2 = colFolders_1
Set colFolders_1 = New Collection
For Each i In colFolders_2
Set FS_Folders = FS.GetFolder(i)
Set FS_subFolders = FS_Folders.SubFolders
For Each j In FS_subFolders
Set FS_Folders = FS.GetFolder(j.Path)
colFolders_1.Add j.Path
Set FS_Files = FS_Folders.Files
DoEvents
For Each k In FS_Files
GoSub CheckFileName
Next k
Next j
Next i
If colFolders_1.Count 0 Then
GoTo Start
End If

Exit_Sub:
ThisWorkbook.Save
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Exit Sub

CheckFileName:
If InStr(1, k.Name, "Source") And Right(k, 4) = ".xls" Then
h = h + 1
Set SourceFile = xlApp.Workbooks.Open(k)
Set SourceRange =
SourceFile.Worksheets("CASH").Range ("A1:H100")
For n = 1 To NumRow
For m = 1 To NumCol
TargetRange(n + NumRow * (h - 1), m) = SourceRange(n,
m)
Next
Next
SourceFile.Close
End If
Return

FolderNotFound:
MsgBox "Err. " & Err.Number & " - " & _
Err.Description & vbCrLf & vbLf & _
"Folder: " & UCase(SourceFolder) & _
" -- Not Found."
Resume Exit_Sub

End Sub


 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
import multiple text files into single sheet separate column Jootje Excel Programming 10 February 8th 08 05:09 PM
Combining multiple worksheets into a single master sheet Albert Excel Programming 2 January 11th 08 04:01 PM
Copy Range From Multiple Worksheets to a Single Worksheet Dauntless1 Excel Discussion (Misc queries) 5 August 17th 07 01:59 AM
macro: copy multiple workbooks to multiple tabs in single book Michael Excel Programming 0 July 14th 06 04:53 PM
opening multiple .txt files from multiple folders Corben Excel Discussion (Misc queries) 3 March 16th 06 12:43 AM


All times are GMT +1. The time now is 02:51 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"