Rename Folder/File located in a server using Excel VBA - excel

Question

I'm writing a Macro which main function is to rename folders in a specific server location (Main folder). All the files on this Main Folder have the 3 first characters as numbers which are in sequential order. Since I'm changing them often I wanted a Macro which was able to rename the folders from a item up (this item would be the first 3 characters of a folders name)
The the issue I have is that since the files are in a server I cannot really change the name, it seams like I just can change the name which appears to the user but not the "real"/first name.
Perhaps with a couple of images it might help:
The code we are using is the following:
Private Sub PrintFolders()
Dim objFSO As Object
Dim objFSO_2 As Object
Dim objFolder As Object
Dim objSubFolder As Object
Dim fileExcel As Object
Dim xpto As Object
Dim objSubSubFile_Excel As Object
Dim auxStringName As String, auxStringPath As String
Dim i As Integer
Application.StatusBar = ""
'Get Folder Path
auxStringPath = Range("C2").Text
If auxStringPath = "" Then
Err = 19
GoTo handleCancel
End If
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder(auxStringPath)
i = 0
'Get intBegin
intBegin = CInt(Range("C3").Value)
'loops through each folder in the directory and prints their names and path
On Error GoTo handleCancel
Application.EnableCancelKey = xlErrorHandler
'MsgBox "This may take a long time: press ESC to cancel"
For Each objSubFolder In objFolder.subfolders
Application.StatusBar = objSubFolder.Path & " " & objSubFolder.Name
If CInt(Left(objSubFolder.Name, 3)) >= intBegin Then
If intBegin < 10 Then
auxStringName = "00" & CStr(intBegin + i) & Mid(objSubFolder.Name, 4)
ElseIf intBegin < 100 Then
auxStringName = "0" & CStr(intBegin + i) & Mid(objSubFolder.Name, 4)
Else
auxStringName = CStr(intBegin + i) & Mid(objSubFolder.Name, 4)
End If
For Each fileExcel In objSubFolder.Files
If Right(fileExcel.Name, 4) = "xlsx" Or Right(fileExcel.Name, 4) = "xlsm" Then
Name auxStringPath & "\" & objSubFolder.Name & "\" & fileExcel.Name As auxStringPath & "\" & objSubFolder.Name & "\" & Left(auxStringName, 3) & Mid(fileExcel.Name, 4)
End If
Next fileExcel
Name auxStringPath & "\" & objSubFolder.Name As auxStringPath & "\" & auxStringName
i = i + 1
End If
Next objSubFolder
handleCancel:
If Err = 18 Then
MsgBox "You cancelled"
ElseIf Err = 19 Then
MsgBox "Missing Path"
End If
Set objFSO = Nothing
Set objFolder = Nothing
End Sub
Does anyone can help on this?
Does anzone has alreadz had a similar issue?