Crear una carpeta

[albina]

Buenas les explico mi problemita: yo selecciono un mes del año y tengo que crear una carpeta con el nombre de ese mes, hasta ahi todo bien, el problema es que tengo dos empresas y tengo que crearles una carpeta para cada empresa con el mismo nombre pero en directorios diferentes, cuando crea la primera no hay drama pero cuando voy a crear la segunda me dice que ya existe, si bien yo verifico en el directorio correspondiente que no este, al crearla es como que pierde la ruta.
Les paso el código con el cual la creo haber si alguien me puede decir que esta mal.
Desde ya gracias.


Sub AgregarNuevaCarpeta(nombredecarpeta)
'CREA UNA NUEVA CARPETA PARA EL PERIODO INGRESADO, SI LA CARPETA YA EXISTE SOLO AVISA
Dim fso, f, fc, nf
Dim ruta As String

Set fso = CreateObject("Scripting.FileSystemObject")
If opUser.Distribuidora = 1 Then ''EMPRESAUNO
ruta = App.path & "\importados\EMPRESAUNO"
Else EMPRESADOS
ruta = App.path & "\importados\EMPRESADOS
End If

If fso.FolderExists(ruta & "\" & nombredecarpeta) Then
Set f = fso.GetFolder(ruta)
Set fc = f.SubFolders
If nombredecarpeta <> "" Then
fso.CreateFolder ruta & "\" & nombredecarpeta
'Set nf = fc.Add(nombredecarpeta)
End If
Else
MsgBox "La carpeta ya existe"
End If

End Sub
Private Function noesta(dato As String) As Boolean
'VERIFICA QUE LA CARPETA QUE SE ESTA POR CREAR NO EXISTA
Dim ruta As String
Dim fc

noesta = True
Set fc = CreateObject("Scripting.FileSystemObject")
If opUser.Distribuidora = 1 Then ''EMPRESAUNO
If fc.FolderExists(App.path & "\importados\EMPRESAUNO\" & dato) Then
noesta = True
Else
noesta = False
End If
Else ''EMPRESADOS
If fc.FolderExists(App.path & "\importados\EMPRESADOS& dato) Then
noesta = True
Else
noesta = False
End If
End If

End Function