MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

4 participantes

    Buscar diretório de pasta ou arquivo interativamente

    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3715
    Registrado : 22/11/2016

    Buscar diretório de pasta ou arquivo interativamente Empty Buscar diretório de pasta ou arquivo interativamente

    Mensagem  DamascenoJr. 12/10/2020, 20:05

    Pra mim, isso substitui o método mostrado na mensagem deste link, pois funciona facilmente tanto em 32 quanto 64 bits

    E também posso traquilamente reaproveitar o código em novos projetos sem me preocupar com problema de referência, como previsto neste link, e ocorrido neste link, neste, neste, neste, neste, e neste. E o que complica mais é que, pra mim e para alguns colegas, a referência nunca está facilmente na lista, sempre era preciso executar estes passos.

    Agora não mais! E espero que você também não.

    Em um módulo global
    Código:
    Public Enum ePastaOuArquivo
        Pasta = 4
        Arquivo = 3
    End Enum

    Public Function fncBuscaDir(ByVal TipoObjeto As ePastaOuArquivo, _
                                Optional ByVal arrFiltro, _
                                Optional ByVal booSelecaoMultipla As Boolean = False) _
                                As String
    ' ----------------------------------------------------------------
    ' Autor      : DamascenoJr. (contato@damascenojr.com.br)
    ' Data      : 11/10/2020
    ' Propósito  : Buscar o diretório de uma pasta ou arquivo(s).
    ' * Observação
    ' - Filtro em array: ex dim arrFiltro (1 To QtdFiltro, 1 To 2) As String
    ' ** Exemplo: arrFiltro(1, 1) = "Arquivo Excel" ou "Todos"
    '            arrFiltro(1, 2) = "xls,xlsx"      ou "*"
    ' ----------------------------------------------------------------

    On Error GoTo trataErro

        Dim objFD
        Dim bytContador     As Byte
        Dim strResultado    As String
        
        Set objFD = Application.FileDialog(TipoObjeto)
        
        With objFD
        
            If TipoObjeto = Arquivo Then
            
                .Title = "Selecione " & IIf(booSelecaoMultipla, "os arquivos", "o arquivo")
                .AllowMultiSelect = booSelecaoMultipla
                .ButtonName = "Abrir"
                
                 With .Filters
                
                    .Clear
                
                    If IsArray(arrFiltro) Then
                        For bytContador = LBound(arrFiltro, 1) To UBound(arrFiltro, 1)
                            If arrFiltro(bytContador, 1) <> "" Then
                                Call .Add(arrFiltro(bytContador, 1), "*." & Replace(arrFiltro(bytContador, 2), ",", ",*."), bytContador)
                            End If
                        Next bytContador
                    Else
                        .Add "Arquivo", "*.*", 1
                    End If
                    
                End With
                
            Else
                .Title = "Selecione a pasta"
                .AllowMultiSelect = False
                .ButtonName = "Selecionar"
            End If
            
        End With
        
        If objFD.Show Then
            
            For bytContador = 1 To objFD.SelectedItems.Count
                strResultado = strResultado & "|" & objFD.SelectedItems(bytContador)
            Next bytContador
            
            fncBuscaDir = Mid(strResultado, 2)
        
        End If
        
    sair:
    On Error Resume Next
        Set objFD = Nothing
        Exit Function
        
    trataErro:
        fncBuscaDir = ""
        Resume sair

    End Function
    Anexos
    Buscar diretório de pasta ou arquivo interativamente AttachmentbdBuscaDir.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (39 Kb) Baixado 194 vez(es)


    .................................................................................
    Ajude-se a ser ajudado, anexe seu projeto.
    Sempre tente entender o código,
    não somente copie e cole.
    Positive as mensagens que achar útil clicando no '+' no canto superior direito delas.

    Avelino Sampaio e crysostomo gostam desta mensagem

    Alvaro Teixeira
    Alvaro Teixeira
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7700
    Registrado : 15/03/2013

    Buscar diretório de pasta ou arquivo interativamente Empty Re: Buscar diretório de pasta ou arquivo interativamente

    Mensagem  Alvaro Teixeira 13/10/2020, 10:11

    Olá Ivan Damasceno,

    Parabéns, excelente partilha Wink

    Abraço
    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3715
    Registrado : 22/11/2016

    Buscar diretório de pasta ou arquivo interativamente Empty Re: Buscar diretório de pasta ou arquivo interativamente

    Mensagem  DamascenoJr. 13/10/2020, 12:12

    Obrigado pelo retorno.


    .................................................................................
    Ajude-se a ser ajudado, anexe seu projeto.
    Sempre tente entender o código,
    não somente copie e cole.
    Positive as mensagens que achar útil clicando no '+' no canto superior direito delas.
    Carvalho
    Carvalho
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 226
    Registrado : 19/01/2013

    Buscar diretório de pasta ou arquivo interativamente Empty Re: Buscar diretório de pasta ou arquivo interativamente

    Mensagem  Carvalho 25/10/2020, 22:40

    Tu és o melhor Damascedo, Obrigado pelas contribuições que você vem nos dando para o nossos estudos cada uma melhor que a outra.
    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3715
    Registrado : 22/11/2016

    Buscar diretório de pasta ou arquivo interativamente Empty Re: Buscar diretório de pasta ou arquivo interativamente

    Mensagem  DamascenoJr. 25/10/2020, 23:22

    Very Happy , valeu, Carvalho


    .................................................................................
    Ajude-se a ser ajudado, anexe seu projeto.
    Sempre tente entender o código,
    não somente copie e cole.
    Positive as mensagens que achar útil clicando no '+' no canto superior direito delas.
    =>Nois
    =>Nois
    Super Avançado
    Super Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 962
    Registrado : 09/11/2012

    Buscar diretório de pasta ou arquivo interativamente Empty Re: Buscar diretório de pasta ou arquivo interativamente

    Mensagem  =>Nois 26/10/2020, 17:58

    cheers Me salvou, obrigado!


    .................................................................................
    Att. Nois

    Se tudo não der certo... tente de novo drunken

      Data/hora atual: 28/11/2022, 01:19