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
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?
I also felt resources of some kind might be an issue. I'll try your idea and let you know. Thanks!
Without "name" it works, freezes with it. Probably an open file handle problem. This good news and bad news :(
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.
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
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.