Count Folders and Rename Folders VBA Excel
The code and workbook below counts the number of folders in a folder. It then renames the folders in that folder incrementally based on the values in cells A1, A2, A3, A4, etc.
Code:
Sub foldernaming()
'count the number of files in a folder (ignore - I have this commented out)
'Dim folderpath As String, path As String, count As Integer
'folderpath = "C:\Users\18622\OneDrive\Desktop\New folder\"
'Filename = Dir(folderpath)
'Do While Filename <> ""
'count = count + 1
'Filename = Dir()
'Loop
'MsgBox count
Dim xx As Double
Dim oFSO As Object
Dim folder As Object
Dim subfolders As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set folder = oFSO.GetFolder("C:\Users\18622\OneDrive\Desktop\New folder\")
Set subfolders = folder.subfolders
xx = subfolders.count
Set oFSO = Nothing
Set folder = Nothing
Set subfolders = Nothing
'release memory
Dim strOldDirName As String
Dim strNewDirName As String
Dim x As Double
x = 1
erow = Range("A" & Rows.count).End(xlUp).Row
Dim foldername As String
Do Until x > erow
foldername = Range("A" & x).Value
strOldDirName = "C:\Users\18622\OneDrive\Desktop\New folder\" & x & "\"
strNewDirName = "C:\Users\18622\OneDrive\Desktop\New folder\" & foldername & "\"
Name strOldDirName As strNewDirName
x = x + 1
If x > xx Then
GoTo endingbecausecountofFoldersGreaterthanCellsinColumnA:
End If
Loop
endingbecausecountofFoldersGreaterthanCellsinColumnA:
End Sub