VBA / VB6 - Velg en liste over filer med Windows Utforsker

Velg en liste over filer (eller bare en) med API: GetOpenFileName.

En forenklet funksjon ved hjelp av Windows Utforsker.

Denne koden fungerer også i VBA, forutsatt at du justerer kontrollene.

Du kan endre

tittelen
Returneringen av en enkelt fil ved å fjerne konstanten OFN_ALLOWMULTISELECT
Den gamle versjonen av Explorer ved å fjerne konstant OFN_EXPLORER

Koden

 '********************************' Auteur -> Lermite222 'Sélection d'une liste de fichiers' avec l 'explorateur Windows' Versjon 1 '29 / 01/2012 '******************************** Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _ "GetOpenFileNameA" (pOpenfilnavn som OPENFILENAME) Så lenge privat type OPENFILENAME lStrukturer så lenge hWndOwner så lenge hInstance så lenge lpstrFilter som streng lpstrCustomFilter som streng nMaxCustFilter så lenge nFilterIndex så lang lpstrFile som streng nMaxFile så lenge lpstrFileTitle As Long string nMaxFileTitle så lenge lpstrInitialDir As string lpstrTitle As string flagg så lenge nFileOffset As Integer nFileExtension As Integer lpstrDefExt As string lCustData As Long lpfnHook As Long lpTemplateName As string End Type Offentlig 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 Nummer Private Sub Command1_Click () Dim Retour som streng, jeg som helhet Dim TB Retour = ListeFichier () Hvis Retour = "" Deretter avslutter Sub 'L'utilisateur à annullere TB = Split (Retur, vbNullChar)' Séparation de la liste si existe Hvis Ubound (TB) = 0 Da 'un seul fichier sélectionner For I = Len (TB (0)) Til 1 Trinn -1 Hvis Mid (TB (0), I, 1) = "\" Avslutt deretter til neste liste1.AddItem Mid (TB ), i + 1) TB (0) = Venstre (TB (0), i) Else 'Une liste est disponnible For i = 1 Til Ubundet (TB) Liste1.AddItem TB (i) Neste End Hvis Label1.Caption = TB (0) Slutt Sub Private Sub Command2_Click () List1.Clear Label1 = "" End Sub Function ListeFichier () Som String Dim Ret Som L ong Dim LN_Ouv Som OPENFILENAME LN_Ouv.lStructSize = Len (LN_Ouv) LN_Ouv.hWndOwner = Me.hWnd LN_Ouv.hInstance = App.hInstance LN_Ouv.lpstrFilter = "Musikk (* .mp3)" + Chr $ (0) + "* .mp3 "+ Chr $ (0) +" Tous (*. *) "+ Chr $ (0) +" *. * "+ Chr $ (0) LN_Ouv.lpstrFile = String $ (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" "Titre de l'explorateur" -direktivet gir deg muligheten til å legge til plakat. LN_Ouv.flags = OFN_ALLOWMULTISELECT + OFN_EXPLORER 'Affichage de l'explorateur Ret = GetOpenFileName (LN_Ouv) Hvis Ret = 0 Så ListeFichier = "" Else ListeFichier = Venstre $ (LN_Ouv.lpstrFile, InStr (1, LN_Ouv.lpstrFile, vbNullChar & vbNullChar) - 2) Slutt hvis sluttfunksjon