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
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 SubSi 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.
