I Keep getting A run time 5 at the end before the loop at fileName = Dir and I'm not sure why this is happening.
GOAL: Take Quality forms that were submitted to the dropbox and rename them
GOAL: Take Quality forms that were submitted to the dropbox and rename them
VBA Code:
Sub RenameExcelFilesBasedOnControlSheet()
Dim folderPath As String
Dim fileName As String
Dim wb As Workbook
Dim newFileName As String
Dim controlSheet As Worksheet
Dim controlValue As String
Dim workbookPassword As String
Dim sheetPassword As String
Dim invalidChars As String
Dim i As Long
folderPath = "Y:\Spokane Contact Center\Contact Center Managers\~2025 Quality Drop Box\"
If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
If Dir(folderPath, vbDirectory) = "" Then
MsgBox "The specified folder does not exist: " & folderPath
Exit Sub
End If
workbookPassword = "QAForm25"
sheetPassword = "QAControl"
fileName = Dir(folderPath & "*.xlsx")
Do While fileName <> ""
On Error Resume Next
Set wb = Workbooks.Open(folderPath & fileName, Password:=workbookPassword)
If Err.Number <> 0 Then
MsgBox "Failed to open " & fileName & ". It may be password protected or corrupted."
Err.Clear
fileName = Dir ' Get the next file
GoTo NextFile
End If
On Error GoTo 0
On Error Resume Next
Set controlSheet = wb.Sheets("!CONTROL")
On Error GoTo 0
If Not controlSheet Is Nothing Then
On Error Resume Next
controlSheet.Unprotect Password:=sheetPassword
On Error GoTo 0
controlValue = Trim(controlSheet.Range("F1").Value) & "-" & Trim(controlSheet.Range("G1").Value)
invalidChars = "/\:*?""<>|"
For i = 1 To Len(invalidChars)
controlValue = Replace(controlValue, Mid(invalidChars, i, 1), "_")
Next i
newFileName = folderPath & controlValue & ".xlsx"
If Dir(newFileName) = "" Then
On Error Resume Next
wb.SaveAs newFileName, FileFormat:=xlOpenXMLWorkbook
If Err.Number <> 0 Then
MsgBox "Error saving file " & newFileName & ": " & Err.Description
Err.Clear
Else
Kill folderPath & fileName
End If
On Error GoTo 0
Else
MsgBox "File " & newFileName & " already exists. Skipping rename for " & fileName
End If
wb.Close SaveChanges:=False
Else
MsgBox "Sheet 'CONTROL' not found in " & fileName & ". Skipping this file."
wb.Close SaveChanges:=False
End If
NextFile:
fileName = Dir
Loop
MsgBox "Renaming and deletion of original files completed!"
End Sub