Abrir carpeta con Botón en formulario
Estoy intentando crear un código en vba para integrarlo en el botón de un formulario en access para que me abra una carpeta determinada.
Parte del nombre de la carpeta lo toma del cuadro de texto [Expediente] que solo tiene tres números.
El nombre de la carpeta puede ser que solo tenga tres números y otras veces serán tres números más otro texto, por ejemplo: 001, 002-tierra, 003, 004-verde, 005-nieve, 006, etc
El código que utilizo es:
Private Sub Abrir_Carpeta_Click()
Dim NombreCarpeta As String
Dim Nombre As String
Dim Arbol As String
NombreCarpeta = Mid(Me.[Expediente], 1, 3)
Arbol = "explorer H:\Bases de datos\"
Nombre = [Arbol] & [NombreCarpeta]
Shell (Nombre) & "*", vbMaximizedFocus
End Sub
Con ese código si el nombre de la carpeta solo tiene tres números la abre perfectamente, pero cuando tiene los tres números más algo más, abre la carpeta Document.
¿Qué estoy haciendo mal?
1 Respuesta
Cómo en NombreCarpeta siempre asigna 3 caracteres, lógicamente se abrirán las que tengan esta cantidad de caracteres. Le propongo esta solución utilizando Application. FileDialog.
Selecciono la carpeta, ahora hago clic en Aceptar y obtengo el contenido de la carpeta son Shell()
CÓDIGO DEL BOTON ELEGIR CARPETA
Private Sub btnElegir_Click()
Me.ctlCarpeta = selectCarpeta
If Len(Me.ctlCarpeta) = 0 Then
Exit Sub
Else
Shell ("Explorer " & Me.ctlCarpeta), vbMaximizedFocus
End If
End SubCÓDIGO DE LA FUNCION SELECTCARPETA
Esta función la puede incluir a nivel formulario.
Function selectCarpeta() As String On Error GoTo sol_err Dim vFD As Object Dim vRutaIni As String 'Difinimos la ruta inicial vRutaIni = Application.CurrentProject.Path ' Puede dejar la carpeta por defecto Set vFD = Application.FileDialog(msoFileDialogFolderPicker) With vFD .Title = "Seleccione la carpeta" .ButtonName = "Aceptar" .InitialView = msoFileDialogViewList .InitialFileName = vRutaIni If .Show = -1 Then selectCarpeta = CStr(.SelectedItems.Item(1)) Else MsgBox "Ha cancelado la selección", vbOKCancel Or vbExclamation Or vbMsgBoxSetForeground, "Carpeta.." Exit Function End If End With Salida: Exit Function sol_err: MsgBox "Se ha producido un error: " & Err.Number & " - " & Err.Description Resume Salida End Function
Debe hacer referencia a Microsoft Office 16.0 Object Library o a su versión equivalente.
