Sélectionner des fichiers ou des dossiers

Il peut être extrêmement pratique de pouvoir accéder aux boîtes de dialogues standard d'Office telles que Fichier//Ouvrir ou Enregistrer sous, afin de sélectionne un dossier, ou un/plusieurs fichiers.

Choix d'un dossier

L'exécution de ce code affichera la boîte de dialogue standard de choix d'un dossier :

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

On peut ensuite l'afficher avec un MsgBox :

Sub Test1()
  Dim Dossier
  Application.FileDialog(msoFileDialogFolderPicker).Show
  Dossier = Application.FileDialog(msoFileDialogFolderPicker).InitialFileName
  MsgBox Dossier
End Sub

Sélection d'un seul fichier

Sub Test1()
  Application.FileDialog(msoFileDialogFilePicker).AllowMultiSelect = False
  Application.FileDialog(msoFileDialogFilePicker).Show
  MsgBox Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1)
End Sub

Sélection de plusieurs fichiers

Count contient le nombre de fichiers (On commence par 1, pas par 0)

Sub Test6()
  Dim Ctr
  Application.FileDialog(msoFileDialogFilePicker).AllowMultiSelect = True
  Application.FileDialog(msoFileDialogFilePicker).Show
  For Ctr = 1 To Application.FileDialog(msoFileDialogFilePicker).SelectedItems.Count
    MsgBox Application.FileDialog(msoFileDialogFilePicker).SelectedItems(Ctr)
  Next
End Sub

Boîtes de dialogues "Save As" et "Open"

Save As

Il est possible d'afficher la boîte de dialogue Save As comme ceci :

Application.FileDialog(msoFileDialogSaveAs).Show
MsgBox Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1)

Le fonctionnement est pareil, sauf que à la place du bouton OK, on a un bouton Save As. Si on sélectionne un fichier existant déjà, on a le message traditionnel "Voulez-vous écraser le fichier" existant, mais évidemment, il n'écrase rien du tout, même si on dit oui.

Attention : Dans Excel, j'ai constaté que la méthode précédente montrait bien le bouton Enregistrer, mais il n'enregistre pas. La méthode suivante permet de prédéfinir un nom de fichier, et l'enregistrement se passe correctement :

SendKeys ("Offre de formation")
Application.Dialogs(xlDialogSaveAs).Show

Open

Application.FileDialog(msoFileDialogOpen).Show
MsgBox Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1)

Ici, on doit absolument choisir un fichier existant, sinon le bouton Open est inopérant.

Récupération du nom du dossier contenant le fichier sélectionné

Contrairement à ce qu'on pourrait imaginer, InitialFileName renvoie le DOSSIER.

Sub Test1()
  Application.FileDialog(msoFileDialogFilePicker).Show
  MsgBox Application.FileDialog(msoFileDialogFilePicker).InitialFileName
End Sub

Utilisation de plusieurs options

' Sélection d'un dossier de base :
Application.FileDialog(msoFileDialogOpen).InitialFileName = "F:\Docs"
' Affichage d'un titre particulier dans la boite de dialogue :

Application.FileDialog(msoFileDialogOpen).Title = "Choix du modèle"
' Effacement de tous les filtres de fichiers éventuels (Extensions) :

Application.FileDialog(msoFileDialogOpen).Filters.Clear
' Application d'un filtre particulier (On pourrait ajouter d'autres Add en dessous) :
Application.FileDialog(msoFileDialogOpen).Filters.Add "Modèles", "*.dot; *.dotx; *.dotm", 1
' Affichage de la boîte de dialogue ainsi initialisée :
Application.FileDialog(msoFileDialogOpen).Show
' Affichage du dossier, suivi du fichier choisi :
MsgBox Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1)

Une alternative consiste à exploiter les DLL

Nous allons recourir aux DLL pour arriver à nos fins :.

Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type

Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long

Public Function ChoixDossier(Titre)
Dim Rien As Integer
Dim Liste As Long
Dim Resultat As String
Dim Browse_info As BrowseInfo
With Browse_info
.lpszTitle = lstrcat(Titre, "")
.ulFlags = 1
End With
Liste = SHBrowseForFolder(Browse_info)
If Liste Then
Resultat = String$(260, 0)
SHGetPathFromIDList Liste, Resultat
CoTaskMemFree Liste
Rien = InStr(Resultat, vbNullChar)
If Rien Then
ChoixDossier = Left$(Resultat, Rien - 1)
End If
End If
End Function

Sub Test()
MsgBox ChoixDossier("Choisissez le dossier")
End Sub