Crear carpetas en directorio por buscador de carpetas, en access

Tengo un formulario llamado EXPEDIENTES, el cual tengo un campo con llamado “NumArticulo”, que me da el nº de expediente. Al dar al botón CREAR CARPETA, quiero que me cree una carpeta en un directorio determinado localizado mediante un modulo con una función de BuscarCarpeta.

Mi problema es que no consigo meter la nueva carpeta en el directorio designado.

Las funciones las he encontrado buscando por Internet y las he adaptado como he podido ya que de vba Access no lo domino.

No sé realmente lo que falla, ya que ahora no me crea carpeta y otras veces después de trastear, me crea la carpeta, pero no en el lugar indicado.

Un saludo

============================================================

Private Sub Comando38_Click()

'CREO LAS VARIANTES

Dim STRDIR As String

Dim strCarpeta As String

Dim Contador As Integer

Dim MIRUTA As String

Dim MICARPETA As String

Dim ret As String

'CARGO NOMBRE CARPETA.

strCarpeta = Me.NumArticulo

'INICIAMOS CONTADOR A CERO.

Contador = 0

ret = Buscar_Carpeta("Seleccione o cree una carpeta")

MIRUTA = ret 'ESTABLECE LA RUTA.

MICARPETA = Dir(MIRUTA, VBDDIRECTORY)

   Do While MICARPETA <> "" 'INICIA EL BUCLE.

'IGNORA EL DIRECTORIO ACTUAL Y EL QUE LO ABARCA.

   If MICARPETA <> "." And MICARPETA <> ".." Then

'Realiza una comparacion a nivel bit para asegurarse de q MICARPETA es un directorio.

   If [GETATTR(MIRUTA&MICARPETA ) AND vbDirectory] = vbDirectory Then

   If MICARPETA Like strCarpeta Then

   Contador = 1

   End If

   End If   'Solamente si representa un directorio.

   End If

   MICARPETA = Dir

   Loop

'Si contador es igual a 0 es q no ha encontrado la carpeta en el directorio y lo crea.

If Contador = 0 Then

' Como no existe asignas la ruta del directorio.

 STRDIR = MIRUTA

'CREO DIRECTORIO.

MkDir STRDIR

MsgBox ("La Carpeta ha sido creada, con el nº de Expediente") & " " & Me.NumArticulo

End If

End Sub

1 Respuesta

Respuesta
1

Prueba algo más simple:

Private Sub Comando38_Click()
On Error Resume Next
Dim laRuta As String
laRuta=Buscar_Carpeta("Seleccione o cree una carpeta")
laRuta=laRuta & "\" & Me.NumArticulo
MkDir laRuta
End Sub

Si la carpeta existe, saltará un error (el 75, concretamente), pero con el Resume Next lo ignorará y no hará nada. Si la carpeta no existe, la creará.

Un saludo.


¡Gracias!  Muchas gracias.

Después de ver tu solución, en los diversas modificaciones que hice estuve cerca, pero no llegaba a la resolución final.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas