[Resolvido] Renomear - Inserir 3 caracteres em determinada posição

Exmos. Senhores

Tenho uma enorme quantidade de pastas para renomear e encontrei um exemplo que faz o seguinte:
United States  transforma para States, United
U. S. America transforma para America, U. S.

O exemplo é este:

Código:

Set objFS = CreateObject("Scripting.FileSystemObject")
strFolder = "C:\path\of\folder\of\folders"
Set objFolder = objFS.GetFolder(strFolder)
For Each Folder In objFolder.SubFolders
   strFolderName = Folder.Name
   For i=1 To Len(strFolderName)
      if Mid(strFolderName,i,1) = " " Then
         strEndOfFirst = i
      End If
   Next
   strFirstName = Mid(strFolderName,1,strEndOfFirst)   
   strLastName = Mid(strFolderName,strEndOfFirst + 1)
   strNewName = strLastName & ", " & strFirstName
   Folder.Name=strNewName
Next

Num ficheiro TXT, basta alterar "C:\path\of\folder\of\folders" para a pasta desejada, grava-lo como "rename.vbs" e fazer duplo click.

Mas o que pretendo é diferente, tenho um conjunto de pastas nomeadas desta maneira:
AAA-000001
BBB-000001
CCC-000001

E queria inserir 3 caracteres iguais, ou seja, "XX-" após a 4ª posição à esquerda para ficar assim:
AAA-XX-000001
BBB-XX-000001
CCC-XX-000001

Podem me ajudar a adaptar o exemplo anterior à minha necessidade?

Ogrigado

Bruno Gordino

Já consegui.

Fiz assim:

Código:

Set objFS = CreateObject("Scripting.FileSystemObject")
strFolder = "C:\Users\tosh\Desktop\Nova pasta"
Set objFolder = objFS.GetFolder(strFolder)
For Each Folder In objFolder.SubFolders
   strFolderName = Folder.Name

   For i=1 To Len(strFolderName)
'      if Mid(strFolderName,i,1) = " " Then
'         strEndOfFirst = i
'      End If
   Next
   strInsertName ="XX"
   strFirstName = Mid(strFolderName,1,Len(strFolderName)-6)   
   strLastName = Mid(strFolderName,4)
   strNewName = strFirstName & strInsertName & strLastName
   Folder.Name=strNewName
Next


Obrigado na mesma

Abraço

Bruno Gordino