-
Rename File Folders
Firstly thank you for taking the time to read. Using the following formula folders were automatically created in windows explorer:
Code:
Sub MakeFolders()
Dim Rng As Range
Dim maxRows, maxCols, r, c As Integer
Set Rng = Selection
maxRows = Rng.Rows.Count
maxCols = Rng.Columns.Count
For c = 1 To maxCols
r = 1
Do While r <= maxRows
If Len(Dir(ActiveWorkbook.Path & "\" & Rng(r, c), vbDirectory)) = 0 Then
MkDir (ActiveWorkbook.Path & "\" & Rng(r, c))
On Error Resume Next
End If
r = r + 1
Loop
Next c
End Sub
Unfortunately when this was first run it created the folders with employee surname first then employee number e.g. SMITH 01234567. There are numerous files in each folder of which there are over 500 folders. Is there an easy way to rename these folders so the employee number comes first e.g. 01234567 SMITH?
-
This should work. Check the output in the debug first, before uncommenting Name line
Code:
Sub Test()
pth = "F:\" 'Change to suit
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder(pth)
For Each f In fld.subfolders
x = Split(f.Name)
If UBound(x) = 1 Then
If IsNumeric(x(1)) Then
OldFolderName = pth & f.Name
NewFolderName = pth & x(1) & " " & x(0)
Debug.Print NewFolderName
'Name OldFolderName As NewFolderName
End If
End If
Next
End Sub