Option Explicit
Sub Rename_Folder()
Dim oFSO As Object
Dim oFolder As Object
Dim oSubFolder As Object
Dim i As Integer
Dim strPath As String
Dim strSubFolderPath As String
Dim strSubFolderNewName As String

    strPath = "D:\MIHAI\DOSARE\BAAR"
    strSubFolderNewName = strPath & "\" & "MICHAEL_" & Format(Date, "dd.mm.yyyy_") & _
                          Format(Time, "HH.MM")

    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.GetFolder(strPath)

    For Each oSubFolder In oFolder.SubFolders
        If Not oSubFolder.Name Like "MICHAEL_*" Then 'Optional
            strSubFolderPath = oSubFolder.Path
            Name strSubFolderPath As strSubFolderNewName
            Exit For
        End If 'Optional
    Next oSubFolder
lbl_Exit:
    Set oFSO = Nothing
    Set oFolder = Nothing
    Set oSubFolder = Nothing
    Exit Sub
End Sub