Home |
Search |
Today's Posts |
#5
![]() |
|||
|
|||
![]() Quote:
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 |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
import multiple text files into single sheet separate column | Excel Programming | |||
Combining multiple worksheets into a single master sheet | Excel Programming | |||
Copy Range From Multiple Worksheets to a Single Worksheet | Excel Discussion (Misc queries) | |||
macro: copy multiple workbooks to multiple tabs in single book | Excel Programming | |||
opening multiple .txt files from multiple folders | Excel Discussion (Misc queries) |