Renaming Files using Scripting.FileSystemObject

[OldSchool1948]

I'm running the following code against a set of TIFF files stored in sub-folders that need to be renamed.  There are approximately 25,000 sub-folders; each sub-folder has at least one file - most have multiple, e.g., 50 files.  For some reason, Excel shows "Not responding" after processing about 100 sub-folders and hangs.  I have no idea why.  Any help would be greatly appreciated.

Public Sub RenameImages(strFolderToOpen As String)

On Error GoTo ErrorHandler   ' Enable error-handling routine.
   
    Dim fileSystemObj As Object
    Dim rootFolder As Object
    Dim fileObj As Object
    Dim subFolder As Object
    Dim subFolders As Object
    Dim subFolderName As String
    Dim sFullFileName As String
    Dim FormName As String
    Dim fDelimiter As Integer
    Dim nBatesNum As Long
    Dim nSubFolders As Long
    Dim nFolderNum As Long
    Dim XlWorkSheet As Excel.Worksheet
   
    Set fileSystemObj = VBA.CreateObject("Scripting.FileSystemObject")
   
    Set XlWorkSheet = ActiveWorkbook.Sheets("ImageRenameLog")
       
    If Not fileSystemObj.FolderExists(strFolderToOpen) Then
        MsgBox "Invalid Path"
        Exit Sub
    End If
   
    Set rootFolder = fileSystemObj.GetFolder(strFolderToOpen)
    Set subFolders = rootFolder.subFolders
   
    nSubFolders = subFolders.Count 'Number of subfolders in the selected folder
    fDelimiter = 8 'Length of Bates Number
    nFolderNum = 0 'Initialize Folder Counter
       
    Excel.Application.DisplayStatusBar = True
   
    'Cycle through all subfolders in selected folder
    For Each subFolder In rootFolder.subFolders
       
        'Increment folder number
        nFolderNum = nFolderNum + 1
               
        Excel.Application.StatusBar = _
            "Processing folder " & VBA.Format(nFolderNum, "###,##0") & _
            " of " & VBA.Format(nSubFolders, "###,##0") & " folders"
       
        subFolderName = subFolder.Name
       
        'Extract bates number from folder name
        nBatesNum = CLng(Right(subFolderName, fDelimiter))
       
        'Write Logfile entry, Add 1 initially to skip header row
        XlWorkSheet.Cells(nFolderNum + 1, 1) = subFolderName
        XlWorkSheet.Cells(nFolderNum + 1, 2) = Now
       
        'Cycle through each file in the subfolder
        For Each fileObj In subFolder.Files
           
            'Pad zeros and reconstruct bates number
            sFullFileName = Right("0000" & Trim(Str(nBatesNum)), fDelimiter)
           
            'Construct full file name for each file to be saved in the folder
            sFullFileName = fileObj.parentFolder & "\OCC-" & sFullFileName & ".tiff"
           
            'If file doesn't exist, rename the existing file
            If FileExist(sFullFileName) = False Then
                Name fileObj As sFullFileName
            End If
           
            'Increment bates number
            nBatesNum = nBatesNum + 1
       
        Next
       
    Next
   
exitHere:

    Excel.Application.StatusBar = False
       
    Set fileSystemObj = Nothing
    Set rootFolder = Nothing
    Set subFolders = Nothing
    Set subFolder = Nothing
    Set fileObj = Nothing
    Exit Sub 'Skip ErrorHandler

ErrorHandler:  ' Error-handling routine.
   Select Case Err.Number   ' Evaluate error number.
      Case 6   ' Divide by zero error
         MsgBox ("You attempted to divide by zero!")
         ' Insert code to handle this error
      Case Else
       
   End Select
   
   MsgBox Err.Description, vbCritical, "ProcessData"
   Resume exitHere
   
End Sub

Function FileExist(FilePath As String) As Boolean

    Dim TestStr As String

On Error Resume Next
    TestStr = Dir(FilePath)
On Error GoTo 0

    'Determine if File exists
    If TestStr = "" Then
        FileExist = False
    Else
        FileExist = True
    End If

End Function

[Paul Herber]

My initial thought is that you are running out of resources of some kind: memory, file handles, open file blocks, or something. Assuming that the renaming is happening as you expect it to, what happens if you do all the looping but don't actually do the file renaming i.e just comment out that line temporarily?

[OldSchool1948]

I also felt resources of some kind might be an issue.  I'll try your idea and let you know.  Thanks!

[OldSchool1948]

Without "name" it works, freezes with it.  Probably an open file handle problem.  This good news and bad news 

[AndyW]

I'd be inclined to think that the fact you are renaming files in the subfolder, that is changing the Files collection you are iterating over.

[wapperdude]

Wouldn't th is be better served in an Excel forum rather than a Visio forum...since the reference was to Excel and not Visio?

@Thomas:  I tend to agree with you regarding changing the file collection.  Would seem better to get number of files in subfolder, iterate thru them, starting from last and working toward the beginning count.

Just asking...
Wapperdude

[OldSchool1948]

Thanks everyone for your suggestions.  I'll try iterating backwards. 

I used this forum because I started this project using Visio, but switched to Excel midstream.  I'll remember your point in the future.