VBA / VB6: selezionare un elenco di file con Windows Explorer

Seleziona un elenco di file (o uno solo) con l'API: GetOpenFileName.

Una funzione semplificata che utilizza Esplora risorse.

Questo codice funziona anche in VBA, a condizione di regolare i controlli.

Si può cambiare

il titolo
Il ritorno di un singolo file rimuovendo la costante OFN_ALLOWMULTISELECT
La vecchia versione di Explorer rimuovendo la costante OFN_EXPLORER

Il codice

 '*********************************' Auteur -> Lermite222 'Sélection d'une liste de fichiers' avec l 'explorateur Windows' Versione 1 '29 / 01/2012 '********************************* Funzione dichiarazione privata GetOpenFileName Lib "comdlg32.dll" Alias _ "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long Private Type OPENFILENAME lStructSize As Long hWOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String nMaxCustFilter As Long nFilterIndex As Long lpstrFile As String nMaxFile As Long lpstrFileTitle As String nMaxFileTitle As Long lpstrInitialDir As String lpstrTitle As String bandiere As Long nFileOffset come numero intero nFileExtension come numero intero lpstrDefExt come stringa lCustData As Long lpfnHook As Long lpTemplateName As String End Type pubblico 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 = "" Quindi Esci Sub 'L'utilisateur à annuler TB = Split (Retour, vbNullChar)' Sunto delle liste si existe Se UBound (TB) = 0 Quindi 'un seul fichier sélectionner For i = Len (TB (0)) a 1 Step -1 Se Mid (TB (0), i, 1) = "\" Quindi Esci per la lista successiva1.AddItem Mid (TB (0 ), i + 1) TB (0) = Sinistra (TB (0), i) Altro 'Une elenco est disponnible Per i = 1 To UBound (TB) List1.AddItem TB (i) Next End If Label1.Caption = TB (0) End Sub Private Sub Command2_Click () List1.Clear Label1 = "" End Sub Function ListeFichier () As String Dim 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) + "* .mp3 "+ Chr $ (0) +" Tous (*. *) "+ Chr $ (0) +" *. * "+ Chr $ (0) LN_Ouv.lpstrFile = Stringa $ (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 fichier" La direttiva "Titre de l'explorateur" per le mode d'affichage. LN_Ouv.flags = OFN_ALLOWMULTISELECT + OFN_EXPLORER 'Affichage de l'explorateur Ret = GetOpenFileName (LN_Ouv) Se Ret = 0 Then ListeFichier = "" Else ListeFichier = Sinistra $ (LN_Ouv.lpstrFile, InStr (1, LN_Ouv.lpstrFile, vbNullChar e vbNullChar) - 2) End If End Function