Macro para Crear carpeta en escritorio

Hola, quisiera que me ayudaran con este macro que tengo, quiero crear una carpeta en escritorio de un pc que abra mi archivo. (esta en red), y como sabrán no todos tenemos las mismas ubicaciones ni los mismo nombres de usuario. Tengo esta macro

Sub GenerarCarpeta() Dim Path As String, NombreCarpeta As String, usuario As String

usuario = Application.Workbooks("SIVACF - V 3.0").Sheets("Contenido").Range("XFB3").Value

Path = "C:\Documents and Settings\ & usuario & \Desktop"

NombreCarpeta = "Archivos" Fecha = Format(Now, "dd-mm-yy") 'Verificamos si la carpeta existe ya...

If Dir(Path, vbDirectory) <> "" Then 'Comprueba que la carpeta no existe para crearla.

If Dir(Path & NombreCarpeta & Fecha, vbDirectory) = "" Then MkDir Path & NombreCarpeta & " " & Fecha

End If
End Sub

el usuario lo tomo de una celda que del mismo archivo. Pero no logro crear la carpeta y tampoco me saca error. Por favor sugerencias. O que otro método puedo emplear. Gracias