Cómo mostrar el cuadro de diálogo de selección de archivos en VBA. Existen dos métodos radicalmente diferentes

Mostrar el cuadro de diálogo Archivo con VBA 7

Desde Excel 2010, el motor de programación utiliza VBA 7. VBA 7 ha aportado una enorme simplicidad a la escritura de ciertos procedimientos, como la visualización de cuadros de diálogo.

En VBA 7, la llamada para abrir el cuadro de diálogo "Seleccionar un archivo" se escribe de la siguiente manera.

Sub Ouvrir_Boite_Dialogue()
    Application.FileDialog(msoFileDialogFolderPicker).Show
End Sub

Y para recuperar el nombre del archivo seleccionado, simplemente escriba el siguiente código

Sub Rep_Selection ()
Dim Rep As String
    Application.FileDialog(msoFileDialogFolderPicker).Show
    Rep = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
    MsgBox Rep
End Sub

Como pueden ver, es extremadamente sencillo de codificar. Pero no siempre fue así.

Códigos antiguos (VB6)

Es importante recordar que muchos proyectos de VBA se escribieron hace mucho tiempo. Las siguientes líneas de código probablemente aún estén presentes en algunos programas.

Se recomienda encarecidamente sustituirlos con la técnica descrita anteriormente. Al menos, si estás trabajando con una versión superior a Excel 2010.

Método 1

'Constantes permettant de personnaliser le fonctionnement de BrowseForFolder
Const BIF_RETURNONLYFSDIRS = &H1 'pour chercher les fichiers systèmes seulement
                                    ' si le dossier sélectionné ne contient pas
                                    ' de fichier système alors le bouton "OK" est grisé
Const BIF_DONTGOBELOWDOMAIN = &H2 'interdit d'explorer en dehors du domaine 'For starting the Find Computer
Const BIF_STATUSTEXT = &H4 '
Const BIF_RETURNFSANCESTORS = &H8 'seulement des dossiers
Const BIF_EDITBOX = &H10 'Affiche une zone d'édition
Const BIF_VALIDATE = &H20 'Vérifie la saisie dans la zone d'édition
Const BIF_BROWSEFORCOMPUTER = &H1000 'Autorise le parcours réseau
Const BIF_BROWSEFORPRINTER = &H2000 'mes documents et bureau uniquemnet
Const BIF_BROWSEINCLUDEFILES = &H4000 'dossiers et fichiers
Const BIF_NONEWFOLDERBUTTON = &H200 'ne pas mettre le bouton Nouveau dossier
'affiche la boite de dialogue Windows de recherche d'un dossier
'ou d'un fichier
Sub essai()
    Dim Choix As String
    Choix = ChoixDossierFichier(1)
    If Choix <> "" Then MsgBox Choix
End Sub
Function ChoixDossierFichier(bDos As Boolean) As String
    Dim objShell As Object, objFolder As Object
    Dim Chemin As String, Msg As String
    Dim FlagChoix As Long, NbPoint As Integer
    If bDos Then
      FlagChoix = BIF_RETURNFSANCESTORS
      Msg = "Sélectionner un dossier :"
    Else
      FlagChoix = BIF_BROWSEINCLUDEFILES + BIF_NONEWFOLDERBUTTON
      Msg = "Sélectionner un fichier :"
    End If
                                            
    Set objShell = CreateObject("Shell.Application")
' 1er paramètre toujours 0 (zéro). Il représente le handle de la fenêtre parent
' 2ème paramètre Titre de la boite, en dessous de la barre de titre
' 3ème paramètre options de BrowseForFolder
' 4ème paramètre Facultatif. Répertoire de début d'exploration
    On Error Resume Next
    Set objFolder = objShell.BrowseForFolder(&H0&, Msg, FlagChoix)
    'Si l 'objet retourné est valide, on teste son contenu (item.title)
    'Si on a sélectionné la racine d'une partition, il se compose du nom de la partition,
    ' suivi de sa lettre et ":" entre parenthèses
    NbPoint = InStr(objFolder.Title, ":")
    If NbPoint = 0 Then
        'Sinon, il se compose du nom du dossier uniquement, sans le chemin précédent
        'On récupère ce chemin à l'aide des propriété et méthode ParentFolder.ParseName
        Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
    Else
        ' si racine on récupère la lettre du lecteur et les 2 points
        Chemin = Mid(objFolder.Title, NbPoint - 1, 2)
    End If
    ChoixDossierFichier = Chemin
End Function

Método 2

'-----------------------------------------------------------------
' Variables utilisées pour l'affichage de la boîte de dialogue de 
' recherche de dossier
'-----------------------------------------------------------------
Public Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type
'-----------------------------------------------------------------
' Variables utilisées pour 32-bit API declarations
'-----------------------------------------------------------------
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
  Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal _
  pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
'-----------------------------------------------------------------
' Procédure d'appel de la fonction
'-----------------------------------------------------------------
Sub Procedure_Appel()
Dim Msg As String
    Msg = "Sélectionner le répertoire de traitement."
    
' Appel de la fonction qui retourne le nom du chemin d'accès du 
'  répertoire en mettant en paramètre le titre de la fenêtre.
    Cells(1, 1) = GetDirectory(Msg)
    
End Sub
'------------------------------------------------------------------
' Fonction qui va afficher une boîte de dialogue pour sélectionner
' un répertoire
'------------------------------------------------------------------
Function GetDirectory(Optional Msg) As String
    Dim bInfo As BROWSEINFO
    Dim Path As String
    Dim R As Long, x As Long, pos As Integer
 
'   Répertoire par défaut le bureau
    bInfo.pidlRoot = 0&
'   Title in the dialog
    If IsMissing(Msg) Then
        bInfo.lpszTitle = "Select a folder."
    Else
        bInfo.lpszTitle = Msg
    End If
    
'   Type de repertoire sélectionné
'   En Annexe 3, vous trouverez tous les codes existants
'   d'autres répertoires comme le répertoire Mes Documents, SendTo, …
    bInfo.ulFlags = &H1
'   Affichage de la boîte de dialogue
    x = SHBrowseForFolder(bInfo)
    
'   Décomposition du résultat
    Path = Space$(512)
    R = SHGetPathFromIDList(ByVal x, ByVal Path)
    If R Then
        pos = InStr(Path, Chr$(0))
        GetDirectory = Left(Path, pos - 1)
    Else
        GetDirectory = ""
    End If
End Function

Artículos relacionados

• VBA: lanza un programa en un momento dado
• VBA: cambiar la fecha y hora de un archivo
• VBA: todos los comandos para barras de herramientas y menús
• Analizador de código VBA – Rubberduck
• Elimina acentos en tus celdas usando VBA
• Distribución de gastos con Excel y VBA

Encontrará información adicional sobre el cuadro de diálogo "archivo" en el sitio web de Microsoft.