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
Sub Test1()
Application.FileDialog(msoFileDialogFilePicker).AllowMultiSelect = False
Application.FileDialog(msoFileDialogFilePicker).Show
MsgBox Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1)
End Sub
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
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
Ici, on doit absolument choisir un fichier existant, sinon le bouton Open est inopérant.Application.FileDialog(msoFileDialogOpen).Show
MsgBox Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1)
Contrairement à ce qu'on pourrait imaginer, InitialFileName renvoie le DOSSIER.
Sub Test1()
Application.FileDialog(msoFileDialogFilePicker).Show
MsgBox Application.FileDialog(msoFileDialogFilePicker).InitialFileName
End Sub
' 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)
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