Simi
New member
- Joined
- Feb 10, 2012
- Messages
- 190
- Reaction score
- 0
- Points
- 0
- Location
- Utah, USA
- Excel Version(s)
- Version 2002 Build 12527.20194
I am trying to clean up some files and need some help with using the File System Object and going through folders.
I have tried using some counters to figure out how many files I am trying to copy, but I seem to be error-ing out before it runs on all the folders/files.
Can someone please help with where I am missing something.
I have tried using some counters to figure out how many files I am trying to copy, but I seem to be error-ing out before it runs on all the folders/files.
Can someone please help with where I am missing something.
Code:
Private Sub Consolidate(strFolder As String, wbMaster As Workbook)
Dim objFso As Object
Dim objFiles As Object
Dim objSubFolder As Object
Dim objSubFolders As Object
Dim objFile As Object
Dim ary(3) As Variant
Dim lRow As Long
Dim sFolder As String
'Set Error Handling
On Error GoTo EarlyExit
Dim lCounter As Long
'Create objects to enumerate files and folders
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFiles = objFso.getfolder(strFolder).Files
Set objSubFolders = objFso.getfolder(strFolder).subFolders
lRow = 1
lCounter = 0
Set objFiles = objFso.getfolder(strFolder).Files
For Each objFile In objFiles
With ActiveSheet
If objFile.datelastmodified > .Range("I1") Then
.Range("A" & lRow) = objFile.Path
.Range("C" & lRow) = objFile.datelastmodified
sFolder = Left(objFile.Path, Len(objFile.Path) - Len(objFile.Name) - 1)
sFolder = "T" & Right(sFolder, Len(sFolder) - 1)
Range("B" & lRow) = sFolder
'sFolder = Left(objFile.Path, Len(objFile.Path) - Len(objFile.Name))
'.Range("D" & lRow) = sFolder
If FileFolderExists(sFolder & "") Then
'folder exists
Else
'create the folder
objFso.createfolder (sFolder & "\")
End If
sFolder = sFolder & "\"
objFile.Copy sFolder
lRow = lRow + 1
End If
.Range("I2") = .Range("I2") + 1
End With
lCounter = lCounter + 1
Next objFile
'Go in sub folders and continue.
For Each objSubFolder In objSubFolders
Consolidate objSubFolder.Path, wbMaster
Next objSubFolder
With ActiveSheet
.Range("I3") = lCounter
End With
EarlyExit:
'Clean up
On Error Resume Next
Set objFile = Nothing
Set objFiles = Nothing
Set objFso = Nothing
On Error GoTo 0
End Sub