Selecionar uma lista de arquivo com (ou um só) com a API GetOpenFileName.
Uma função simplificada utilizando o explorador Windows.
Este código funciona igualmente em VBA com a condição d adaptar os controles.
Vous pouvez modifiez
- O título
- O retorno de um só arquivo tirando a constante OFN_ALLOWMULTISELECT
- Explorador antiga versão tirando a constante OFN_EXPLORER
O código
'*********************************
'Autor -> Lermite222
'Seleção de uma lista de arquivos
'com o explorador Windows
'Versão 1
'29/01/2012
'*********************************
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Type OPENFILENAME
lStructSize As Long
hWndOwner 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
flags 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 = &H1000
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
Retorno = ListaArquivo()
If Retorno = "" Then Exit Sub 'O usuário a anular
TB = Split(Retour, vbNullChar) ' Séparation de la liste si existe
If UBound(TB) = 0 Then 'um só arquivo selecionar
For i = Len(TB(0)) To 1 Step -1
If Mid(TB(0), i, 1) = "\" Then Exit For
Next
List1.AddItem Mid(TB(0), i + 1)
TB(0) = Left(TB(0), i)
Else 'Une liste est disponnible
For 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
Função ListsArquivo() As String
Dim Ret As Long
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 = String$(1024, vbNullChar)
LN_Ouv.nMaxFile = Len(LN_Ouv.lpstrFile) - 1 ' Comprimento máximo de seleção de arquivos.
LN_Ouv.lpstrTitle = "Seleção lista de arquivo" ' Título do explorador
' diretiva para a afixagem .
LN_Ouv.flags = OFN_ALLOWMULTISELECT + OFN_EXPLORER
' Afixagem do explorador
Ret = GetOpenFileName(LN_Ouv)
If Ret = 0 Then
ListaArquivo = ""
Else
ListaArquivo = Left$(LN_Ouv.lpstrFile, InStr(1, LN_Ouv.lpstrFile, vbNullChar & vbNullChar) - 2)
End If
End Function
Download
Você pode baixar o projeto
Liste fichiers.zip
Não se esqueça de deszipar
Tradução feita por Ana Spadari
A ver igualmente
Comunidade de assistência e de conselho.
Artigo original publicado por
lermite222. Tradução feita por
ninha25.
