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