Hi,
A few years ago, me and a colleague built the below code as a tool for our team to automatically update the names on our saved files in line with the company records management policy. Now that policy has changed and I need to update the code, and unfortunately my much cleverer colleague who did the more complicated bits has left the company.
Would much appreciate input from anyone on the code, particularly how the bit highlighted in bold actually works. Neither of us had any training or experience in coding at the point we did this, so also feel free to point out superior ways of achieving the end result. Ideally I would also like to expand it to be able to run over multiple sub folders in one run if required.
Many thanks
Matt
Option Explicit
Sub Change_File_Name()
Dim sSht As Worksheet: Set sSht = ThisWorkbook.Sheets("Macro")
Dim tSht As Worksheet: Set tSht = ThisWorkbook.Sheets("Log of file name changes")
Dim strPath As String
Dim sP, tVal As String
Dim oldName(1) As String
Dim newName(1) As String
Dim nLoop, xLoop, yLoop, zLoop As Integer
Dim vPos As Integer
Dim pRow As Long
pRow = tSht.Cells(Rows.Count, 1).End(xlUp).Row + 1
Dim fs As New FileSystemObject
Dim fdr As Folder
Dim f As File
ChooseFolder strPath:=strPath
Set fdr = fs.GetFolder(strPath)
For Each f In fdr.Files
oldName(0) = f.Name
oldName(1) = (fdr & "\" & f.Name)
newName(0) = ""
newName(1) = ""
InputMes tVal:=tVal
vPos = 0
sP = Replace(f.Name, " ", "")
sP = Replace(sP, "_", "")
For xLoop = 1 To Len(sP)
For nLoop = 0 To 9
If Mid(UCase(sP), xLoop, 2) = "V" & nLoop Then
vPos = xLoop
End If
Next nLoop
Next xLoop
**For yLoop = 1 To Len(sP)
If Mid(UCase(sP), yLoop, 3) = "SRV" Or Mid(UCase(sP), yLoop, 3) = "HRV" Then
vPos = 99
End If
Next yLoop**
**If vPos = 0 Then
vPos = Application.Find(".", Right(sP, 5))
If vPos = 1 Then
newName(0) = Format(f.DateCreated, "yyyy-mm-dd") & Trim(Mid(sP, 1, Len(sP) - 5)) & UCase(tVal) & "V01.00" & Trim(Mid(sP, Len(sP) - 4, 200))
newName(1) = (fdr & "\" & Format(f.DateCreated, "yyyy-mm-dd") & Trim(Mid(sP, 1, Len(sP) - 5)) & UCase(tVal) & "V01.00" & Trim(Mid(sP, Len(sP) - 4, 200)))
End If
If vPos = 2 Then
newName(0) = Format(f.DateCreated, "yyyy-mm-dd") & Trim(Mid(sP, 1, Len(sP) - 4)) & UCase(tVal) & "V01.00" & Trim(Mid(sP, Len(sP) - 3, 200))
newName(1) = (fdr & "\" & Format(f.DateCreated, "yyyy-mm-dd") & Trim(Mid(sP, 1, Len(sP) - 4)) & UCase(tVal) & "V01.00" & Trim(Mid(sP, Len(sP) - 3, 200)))
End If
ElseIf vPos <> 99 Then
If UCase(Trim(Mid(sP, vPos - 2, 3))) = "SRV" Or UCase(Trim(Mid(sP, vPos - 2, 3))) = "HRV" Then
newName(0) = Format(f.DateCreated, "yyyy-mm-dd") & Trim(Mid(sP, 1, vPos - 1)) & "V" & Trim(Mid(sP, vPos + 1, 200))
newName(1) = (fdr & "\" & Format(f.DateCreated, "yyyy-mm-dd") & Trim(Mid(sP, 1, vPos - 3)) & UCase(tVal) & "V" & Trim(Mid(sP, vPos + 1, 200)))
Else
newName(0) = Format(f.DateCreated, "yyyy-mm-dd") & Trim(Mid(sP, 1, vPos - 1)) & UCase(tVal) & "V" & Trim(Mid(sP, vPos + 1, 200))
newName(1) = (fdr & "\" & Format(f.DateCreated, "yyyy-mm-dd") & Trim(Mid(sP, 1, vPos - 1)) & UCase(tVal) & "V" & Trim(Mid(sP, vPos + 1, 200)))
End If
End If**
If newName(1) = "" Then
newName(0) = oldName(0)
End If
tSht.Cells(pRow, 1).Value = Format(Now, "dd/mm/yyyy")
tSht.Cells(pRow, 2).Value = fdr
tSht.Cells(pRow, 3).Value = Application.UserName
tSht.Cells(pRow, 4).Value = oldName(0)
tSht.Cells(pRow, 5).Value = newName(0)
pRow = pRow + 1
If newName(1) <> "" Then
Name oldName(1) As newName(1)
End If
Next f
tSht.Activate
End Sub
Function InputMes(ByRef tVal As String)
Do Until tVal = "HR" Or tVal = "SR"
tVal = InputBox("Would you like all the files in the folder to become SR or HR? Please enter the value below")
If tVal = "HR" Or tVal = "SR" Then
Else
tVal = ""
MsgBox "Value entered is not HR or SR"
End If
Loop
End Function
Function ChooseFolder(ByRef strPath As String)
Dim fd As FileDialog: Set fd = Application.FileDialog(msoFileDialogFolderPicker)
Dim fdrChosen As Integer
fdrChosen = fd.Show
fd.InitialView = msoFileDialogViewList
If fdrChosen <> -1 Then
MsgBox "You chose cancel"
Else
strPath = fd.SelectedItems(1)
End If
End Function