To create automatic datewise folder and move the file in it

Question

I am stuck in a situation where I would like to create an automatic date-wise folder on the FTP account. Also, it requires moving one to two files in an updated folder every day. i.e. If it is 28-Dec-22 then the automatic folder with the mentioned format below should be created and the file then should be moved to the updated date folder.

the format of the date will be like this

2023/01/01

This means on the FTP and on the root directory there will be a year folder then in the year folder there will be a month folder and in the month folder, there will be date-wise folders (month and date will folder will be two digits only.

At the start of next month, it requires creating an automatic month folder (within the year folder) and then the normal date folders will be created. that will be 2023/02/01 and so on.

I am using the code mentioned below to move the file from source to destination and it also creates the date-wise folder but in this code, it can only send the file to one selected destination and this cannot be moved into the updated date-wise folder.

Sub moveAllFilesInDateFolderIfNotExist()
 Dim DateFold As String, fileName As String, objFSO As Object
 Const sFolderPath As String = "E:\Uploading\Source"
 Const dFolderPath As String = "E:\Uploading\Destination"
 DateFold = dFolderPath & "\" & Format(Date, "ddmmyyyy") ' create the folder if it does not exist
 If Dir(DateFold, vbDirectory) = "" Then MkDir DateFold
 fileName = Dir(sFolderPath & "\*.*")
 Set objFSO = CreateObject("Scripting.FileSystemObject")
 
 Do While fileName <> ""
    If Not objFSO.FileExists(DateFold & "\" & fileName) Then
        Name sFolderPath & "\" & fileName As DateFold & "\" & fileName

    End If
    fileName = Dir
 Loop
End Sub

Can anyone please help me in this situation?