Public Sub VerificarRutaArchivo(RutaArchivo As String)

 On Error GoTo ErrSub
                                                                                              
    Dim i As Integer
    Dim Array_Dir As Variant
    Dim Sub_Dir As String
    Dim El_Path As String
                                                                                              
    El_Path = RutaArchivo 'InputBox(" Escribir la ruta del directorio a crear " & _
                                    "con los subdirectorios", _
                                    " Crear varios niveles de directorios")
                                                                                              
    If El_Path = vbNullString Then
        Exit Sub
    End If
                                                                                              
    'Desglosa el path y llena el array con los _
     subdirectorios que se irán creando
    Array_Dir = Split(El_Path, "\")
                                                                                              
    El_Path = vbNullString
                                                                                              
    'Recorre el vector anterior para ir creando uno por uno _
     comenzando obviamente desde el directorio de primer nivel
    For i = LBound(Array_Dir) To UBound(Array_Dir)
        Sub_Dir = Array_Dir(i)
        If Sub_Dir <> vbNullString Then
           El_Path = El_Path & Sub_Dir & "\"
           If Right$(Sub_Dir, 1) <> ":" Then
              ' Verificamos que no exista
              If Dir(El_Path, vbDirectory) = vbNullString Then
                 'Crea la carpeta
                  Call MkDir(El_Path)
              End If
           End If
        End If
    Next
                                                                                              
'    MsgBox " Directorio creado ", vbInformation
                                                                                              
'Error
Exit Sub
ErrSub:
                                                                                              
MsgBox "Número de error: " & Err.Number & _
       "Descripción del error: " & Err.Description, vbCritical

End Sub

Verificar y Crear Ruta

Visual Basic