VBA / VB6 - Sélectionnez une liste de fichiers avec l'Explorateur Windows

Sélectionnez une liste de fichiers (ou un seul) avec l'API: GetOpenFileName.

Une fonction simplifiée à l'aide de Windows Explorer.

Ce code fonctionne également dans VBA à condition que vous ajustiez les contrôles.

Vous pouvez changer

le titre
Le retour d'un seul fichier en supprimant la constante OFN_ALLOWMULTISELECT
L'ancienne version d'Explorer en supprimant la constante OFN_EXPLORER

Le code

 '**********************************' Auteur -> Lermite222 'Sélection d'une liste de fichiers' avec l 'explorateur Windows' Version 1 '29 / 01/2012 '********************************* Fonction Declare privée GetOpenFileName "Comdlg32.dll" alias _ "GetOpenFileNameA" (pO comme OPENFILENAME) As Long Private Type OPENFILENAME chaîne nMaxFileTitle As long lpstrInitialDir As string lpstrTitle qu'indicateurs cordes As long nFileOffset As Integer nFileExtension As Integer lpstrDefExt As string lCustData As long lpfnHook As long lpTemplateName As string End type public Enum LnFlags OFN_ALLOWMULTISELECT = & H200 OFN_CREATEPROMPT = & H2000 OFN_ENABLEHOOK = & H20 OFN_ENABLETEMPLATE = & H40 OFN_ENABLETEMPLATEHANDLE = & H80 OFN_EXPLORER = & H80000 OFN_EXTENSIONDIFFERENT = & H400 OFN_FILEMUSTEXIST = & H10 00 OFN_HIDEREADONLY = & H4 OFN_LONGNAMES = & H200000 OFN_NOCHANGEDIR = & H8 OFN_NODEREFERENCELINKS = & H100000 OFN_NOLONGNAMES = & H40000 OFN_NONETWORKBUTTON = & H20000 OFN_NOREADONLYRETURN = & H8000 OFN_NOTESTFILECREATE = & H10000 OFN_NOVALIDATE = & H100 OFN_OVERWRITEPROMPT = & H2 OFN_PATHMUSTEXIST = & H800 OFN_READONLY = & H1 OFN_SHAREAWARE = & H4000 OFN_SHOWHELP = & H10 End Enum Private Sub Command1_Click () Dim Retour As String, i As Integer Dim TB Retour = ListeFichier () If Retour = "" Puis, quittez l'utilisateur à annuler TB = Split (Retour, vbNullChar) 'Séparation de la liste existante si UBound (TB) = 0 Alors, un seul résultat pour i = Len (TB (0)) To 1 Etape -1 Si Mid (TB (0), i, 1) = "\" Puis quittez pour la liste suivante1.AddItem Mid (TB (0 ), i + 1) TB (0) = Gauche (TB (0), i) Sinon, une liste est dispo Pour i = 1 À UBound (TB) List1.AddItem TB (i) Suivant Fin Si Label1.Caption = TB (0) End Sub Private Sub Command2_Click () List1.Clear Label1 = "" End Sub Fonction ListeFichier () As String Dim Ret Ret As L ong Dim LN_Ouv As OPENFILENAME LN_Ouv.lStructSize = Len (LN_Ouv) LN_Ouv.hWndOwner = Me.hWnd LN_Ouv.hInstance = App.hInstance LN_Ouv.lpstrFilter = "Musique (* .mp3)" + Chr * (0). "+ Chr $ (0) +" Tous (*. *) "+ Chr $ (0) +" *. * "+ Chr $ (0) LN_Ouv.lpstrFile = Chaîne $ (1024, vbNullChar) LN_Ouv.nMaxFile = Len (LN_Ouv.lpstrFile) - 1 'Longueur maximum de la sélection des fichiers. LN_Ouv.lpstrTitle = "Sélection liste de fichiers" Directive 'Explorateur' directive for the display mode. LN_Ouv.flags = OFN_ALLOWMULTISELECT + OFN_EXPLORER 'Affichage de l'explorateur Ret = GetOpenFileName (LN_Ouv) If Ret = 0 alors ListeFichier = "" sinon ListeFichier - 2) End If End Function