VB6/VBA - Selecionar uma lista de arquivo com o explorador Windows

Selecionar uma lista de arquivos (ou um só) com o aplicativo GetOpenFileName. Uma função simplificada que utilize o explorador Windows. Este código funciona igualmente em VBA com a condição de adaptar os controles. 



Você pode modificar

• O título
• O retorno de um só arquivo tirando a constante OFN_ALLOWMULTISELECT
• Explorador da 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 Retorno As String, i As Integer 
Dim TB 
    Retorno = ListaArquivo() 
    If Retorno = "" Then Exit Sub 'O usuário anula 
     
    TB = Split(Retorno, vbNulChar) ' Separação da lista se ela existir 
    If UBound(TB) = 0 Then 'selecionar um só arquivo 
        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 'Uma lista está disponível  
        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 ListasArquivo() 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 = "Musica (*.mp3)" + Chr$(0) + "*.mp3" + Chr$(0) + "Todos (*.*)" + 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 exibição. 
    LN_Ouv.flags = OFN_ALLOWMULTISELECT + OFN_EXPLORER 
    ' Exibição 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 na Lista de arquivos .zip 

Não esqueça de descompacta-lo. 

Tradução feita por Ana Spadari
Fonte: Kioskea.

• Twitter
• Facebook
• Google +
• Linkedin
• Pinterest