VBA / VB6 - Выберите список файлов с помощью проводника Windows

Выберите список файлов (или только один) с помощью API: GetOpenFileName.

Упрощенная функция с использованием Windows Explorer.

Этот код также работает в VBA при условии, что вы настраиваете элементы управления.

Ты можешь измениться

  • название
  • Возврат одного файла путем удаления константы OFN_ALLOWMULTISELECT
  • Старая версия Проводника путем удаления константы OFN_EXPLORER

Код

 '*********************************' Автор -> Lermite222 'Avelection d'une liste de fichiers' 'explorateur Windows' версия 1 '29 / 01/2012 '********************************** Private Объявление функции GetOpenFileName Lib "comdlg32.dll" Alias ​​_ "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) в виде длинного закрытого типа OPENFILENAME lStructSize в виде длинного hWndOwner в виде длинного hInstance в виде длинного lpstrFilter в виде строки lpstrCustomFilter в качестве LongstrFF Строка nMaxFileTitle As Long lpstrInitialDir As String lpstrTitle как флаги String 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, я как целое число Dim TB Retour = ListeFichier () If Retour = "" Тогда Exit Sub 'L'utilisateur à annuler TB = Split (Retour, vbNullChar)' Разделение по-прежнему, если UBound (TB) = 0 Тогда 'un seul fichier sélectionner For i = Len (TB (0)) To 1 Шаг -1 Если Mid (TB (0), i, 1) = "\", то выход для следующего List1.AddItem Mid (TB (0) ), i + 1) TB (0) = Слева (TB (0), i) Еще одно непонятное для i = 1 до 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 = "Музыка 0 + (+3) + $ ()) ($ 0) ($)" ()) "+ Chr $ (0) +" Tous (*. *) "+ Chr $ (0) +" *. * "+ Chr $ (0) LN_Ouv.lpstrFile = String $ (1024, vbNullChar) LN_Ouv.nMaxFile = Len (LN_Ouv.lpstrFile) - 1 'Максимальный срок хранения. LN_Ouv.lpstrTitle = "Sélection liste de fichier" Директива "Titre de l'explorateur" для действующего режима. LN_Ouv.flags = OFN_ALLOWMULTISELECT + OFN_EXPLORER 'Affichage de l'explorateur Ret = GetOpenFileName (LN_Ouv) Если Ret = 0, то ListeFichier = "" Else ListeFichier = Левый - 2) End If End Function 

Скачать

Скачать проект можно здесь.

Предыдущая статья Следующая статья

Лучшие советы