MaximoAccess

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

Obrigado

Administração do MaximoAccess

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

    [Resolvido]Salvar o caminho de uma pasta através da janela de localizar do windows

    Compartilhe
    avatar
    waraujo
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 54
    Registrado : 04/02/2010

    [Resolvido]Salvar o caminho de uma pasta através da janela de localizar do windows

    Mensagem  waraujo em Sab Mar 03, 2018 10:39 am

    Ola amigos do Fórum
    Atualmente tenho código para capturar o caminho com um arquivo através da janela do windows, mas gostaria de capturar somente o caminho da pasta....seria possível não estou conseguindo adaptar o código abaixo para fazer isto, ele só aceita se eu selecionar um arquivo..
    Agradeço ao amigos do fórum !!!

    'Codigo Utilizado para capturar o caminho com um arquivo.

    Public Function GetMyFile(strTitle As String) As String

    Dim OpenFile As OPENFILENAME
    Dim lReturn As Long

    OpenFile.lpstrFilter = ""
    OpenFile.nFilterIndex = 1
    OpenFile.hwndOwner = 0
    OpenFile.lpstrFile = String(257, 0)
    #If VBA7 Then
    OpenFile.nMaxFile = LenB(OpenFile.lpstrFile) - 1
    OpenFile.lStructSize = LenB(OpenFile)
    #Else
    OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
    OpenFile.lStructSize = Len(OpenFile)
    #End If
    OpenFile.lpstrFileTitle = OpenFile.lpstrFile
    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
    OpenFile.lpstrInitialDir = "C:\"
    OpenFile.lpstrTitle = strTitle
    OpenFile.flags = 0
    lReturn = GetOpenFileName(OpenFile)

    If lReturn = 0 Then
    GetMyFile = ""
    Else
    GetMyFile = Trim(Left(OpenFile.lpstrFile, InStr(1, OpenFile.lpstrFile, vbNullChar) - 1))
    End If

    End Function


    .................................................................................
    Que Deus Abençoe à todos aqui presente.
    Não Fique Pobre Fazendo Festa com Dinheiro Emprestado.
    Eclesiástico 18,33
    Wellington Araujo
    avatar
    Alexandre Neves
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 6804
    Registrado : 05/11/2009

    Re: [Resolvido]Salvar o caminho de uma pasta através da janela de localizar do windows

    Mensagem  Alexandre Neves em Sab Mar 03, 2018 11:37 am

    Boa tarde,
    Fez pesquisa no fórum? [Você precisa estar registrado e conectado para ver este link.]


    .................................................................................
    Access 2010. Mande bd que dê para testar (indique a versão). Não peça para fazer o que já tem feito. Dê todos os detalhes.
    Não coloquem entraves como senhas, esconder controlos, etc. Disponibilizem o mais limpo possível
    Só respondo a mensagens privadas, se forem de assunto privado; às outras não respondo.
    Quem trabalha e mata a fome não come o pão de ninguém; mas quem não trabalha e come, come sempre o pão de alguém. António Aleixo
    avatar
    waraujo
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 54
    Registrado : 04/02/2010

    Re: [Resolvido]Salvar o caminho de uma pasta através da janela de localizar do windows

    Mensagem  waraujo em Sab Mar 03, 2018 1:58 pm

    Alexandre Tudo bem !!!

    Sim eu vi este Post que você citou, porem não é bem isto ja utilizo a API do Windows para abrir a caixa de Dialogo e selecionar o arquivo, o que eu gostaria é de utilizar esta mesma API mas para selecionar a pasta e não o arquivo, entendeu !
    O post citado lista todas a Pasta e Sub Pasta dentro do caminho, no meu caso o caminho da pasta ira retornar na variável onde sera salva em um campo no Formulário..igual acontece quando você seleciona um arquivo.

    Somente Respondendo eu fiz uma busca sim, porem não localizei a Utilização desta API que postei...não queria substituir todo o código existente.


    .................................................................................
    Que Deus Abençoe à todos aqui presente.
    Não Fique Pobre Fazendo Festa com Dinheiro Emprestado.
    Eclesiástico 18,33
    Wellington Araujo
    avatar
    Alexandre Neves
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 6804
    Registrado : 05/11/2009

    Re: [Resolvido]Salvar o caminho de uma pasta através da janela de localizar do windows

    Mensagem  Alexandre Neves em Sab Mar 03, 2018 3:22 pm

    Já entendi o que precisa
    Já vi aqui no fórum a ter form com árvore de pasta.
    Aguardemos que algum colega tenha e venha partilhar


    .................................................................................
    Access 2010. Mande bd que dê para testar (indique a versão). Não peça para fazer o que já tem feito. Dê todos os detalhes.
    Não coloquem entraves como senhas, esconder controlos, etc. Disponibilizem o mais limpo possível
    Só respondo a mensagens privadas, se forem de assunto privado; às outras não respondo.
    Quem trabalha e mata a fome não come o pão de ninguém; mas quem não trabalha e come, come sempre o pão de alguém. António Aleixo
    avatar
    wearaujo
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 20
    Registrado : 04/02/2010

    Re: [Resolvido]Salvar o caminho de uma pasta através da janela de localizar do windows

    Mensagem  wearaujo em Sab Mar 03, 2018 11:32 pm

    Alexandre vou aguardar algum amigo postar este form....pois seria isto mesmo..mesmo assim agradeço sua atenção e ajuda...caso tenha alguma ideia de como manipular esta API ficarei agradecido..

    Abraço !!!
    Wellington
    avatar
    Alexandre Neves
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 6804
    Registrado : 05/11/2009

    Re: [Resolvido]Salvar o caminho de uma pasta através da janela de localizar do windows

    Mensagem  Alexandre Neves em Dom Mar 04, 2018 11:34 am

    Veja este (http://www.ammara.com/)access_image_faq/browse_for_folder_dialog.html


    .................................................................................
    Access 2010. Mande bd que dê para testar (indique a versão). Não peça para fazer o que já tem feito. Dê todos os detalhes.
    Não coloquem entraves como senhas, esconder controlos, etc. Disponibilizem o mais limpo possível
    Só respondo a mensagens privadas, se forem de assunto privado; às outras não respondo.
    Quem trabalha e mata a fome não come o pão de ninguém; mas quem não trabalha e come, come sempre o pão de alguém. António Aleixo

    Noobezinho
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3632
    Registrado : 29/06/2012

    Re: [Resolvido]Salvar o caminho de uma pasta através da janela de localizar do windows

    Mensagem  Noobezinho em Dom Mar 04, 2018 6:15 pm

    Wellington

    Copie e cole a função a seguir num módulo básico.

    Código:

    Public Function SplitFile(CaminhoCompleto As String, Retorna As Boolean) As String
    On Error Resume Next
        Dim Diretório, Arquivo As String
        Dim total As Long
        total = Len(CaminhoCompleto)
        Do While total > 0
            If Mid$(CaminhoCompleto, total, 1) <> "\" Then
                Arquivo = Mid(CaminhoCompleto, total, 1) & Arquivo
                total = total - 1
            Else
                Diretório = Mid(CaminhoCompleto, 1, total)
                Exit Do
            End If
        Loop
        If Retorna = False Then
            SplitFile = Diretório
        Else
            SplitFile = Arquivo
        End If
    End Function

    Na parte final do teu código, adicione a linha em azul:

    If lReturn = 0 Then
    GetMyFile = ""
    Else
    GetMyFile = Trim(Left(OpenFile.lpstrFile, InStr(1, OpenFile.lpstrFile, vbNullChar) - 1))
    MinhaPasta = SplitFile( "'" & GetMyFile & "'",False)
    End If

    End Function

    Não esqueça do

    Dim MinhaPasta as string

    A função Split() retorna o caminho da pasta quando o argumento é False, e o nome do arquivo quando é True.

    [ ]'s
    avatar
    wearaujo
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 20
    Registrado : 04/02/2010

    Re: [Resolvido]Salvar o caminho de uma pasta através da janela de localizar do windows

    Mensagem  wearaujo em Dom Mar 04, 2018 9:14 pm

    Noobezinho tudo bem !!!

    Cara foi quase lá rsrsrsrs, voce deu a dica certa porem na função da API  OPENFILENAME ele espera receber um arquivo para abrir na tela do windows o botão é Abrir e não um Ok....por este motivo ele não retorna vazio. veja a tela do windows.
    Seria possível utilizar somente o SplitFile para retornar o caminho da pasta assim eu modificaria somente esta parte do código no sistema...eu desconsideraria o retorno pelo GetMyFile ?

    Alexandre vou verificar sua sugestão também beleza.
    Valeu...

    Noobezinho valeu plea dica....aguardo sua resposta aqui também com certeza ira ajudar outros amigos...


    Segue o Cogido Completo


    Public Function GetMyFile(strTitle As String) As String

       Dim OpenFile    As OPENFILENAME
       Dim lReturn     As Long
       Dim MinhaPasta As String
     
       OpenFile.lpstrFilter = ""
       OpenFile.nFilterIndex = 1
       OpenFile.hwndOwner = 0
       OpenFile.lpstrFile = String(257, 0)
       #If VBA7 Then
           OpenFile.nMaxFile = LenB(OpenFile.lpstrFile) - 1
           OpenFile.lStructSize = LenB(OpenFile)
       #Else
           OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
           OpenFile.lStructSize = Len(OpenFile)
       #End If
       OpenFile.lpstrFileTitle = OpenFile.lpstrFile
       OpenFile.nMaxFileTitle = OpenFile.nMaxFile
       OpenFile.lpstrInitialDir = "E:\"
       OpenFile.lpstrTitle = strTitle
       OpenFile.flags = 0
       lReturn = GetOpenFileName(OpenFile)
     
       If lReturn = 0 Then
           GetMyFile = ""
       Else
           GetMyFile = Trim(Left(OpenFile.lpstrFile, InStr(1, OpenFile.lpstrFile, vbNullChar) - 1))
           MinhaPasta = SplitFile("'" & GetMyFile & "'", False)
       End If
     
    End Function


    Public Function SplitFile(CaminhoCompleto As String, Retorna As Boolean) As String
    On Error Resume Next
       Dim Diretório, Arquivo As String
       Dim total As Long
       total = Len(CaminhoCompleto)
       Do While total > 0
           If Mid$(CaminhoCompleto, total, 1) <> "\" Then
               Arquivo = Mid(CaminhoCompleto, total, 1) & Arquivo
               total = total - 1
           Else
               Diretório = Mid(CaminhoCompleto, 1, total)
               Exit Do
           End If
       Loop
       If Retorna = False Then
           SplitFile = Diretório
       Else
           SplitFile = Arquivo
       End If
    End Function
    avatar
    wearaujo
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 20
    Registrado : 04/02/2010

    [Resolvido] Salvar o caminho de uma pasta através da janela de localizar do windows

    Mensagem  wearaujo em Dom Mar 04, 2018 9:47 pm

    Atenção amigo do Forum gostaria de agradecer a todos que contribuiram em especial aos amigos Noobezinho e Alexandre...

    Alexandre perfeito o site que você indicou, era exatamente o que eu precisava, vou ter que modificar a estrutura do sistema mas pelo menos achamos uma solução, fico feliz de poder contar com os amigos aqui...lembre-se de que vale o conhecimento se você não quiser compartilhar, segue o código completo inclusive com as declarações de API para sistema 32 bts e 64 bts....
    Abraço a Todos...


    'Em um Modulo Cole este Código
    '************** Code Start **************
    'This code was originally written by Terry Kreft.
    'It is not to be altered or distributed,
    'except as part of an application.
    'You are free to use it in any application,
    'provided the copyright notice is left unchanged.
    '
    'Code courtesy of
    'Terry Kreft
    '
    '04/03/2018 - Modificado Por Wellington Araujo
    'Incluido API 32 e 64 Bts


    #If VBA7 Then

    Private Type BROWSEINFO
     hOwner As LongPtr
     pidlRoot As LongPtr
     pszDisplayName As String
     lpszTitle As String
     ulFlags As Long
     lpfn As LongPtr
     lParam As LongPtr
     iImage As Long
    End Type

    Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" Alias _
               "SHGetPathFromIDListA" (ByVal pidl As LongPtr, _
               ByVal pszPath As String) As Boolean
               
    Private Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" Alias _
               "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
               As LongPtr
               
    #Else

    Private Type BROWSEINFO
     hOwner As Long
     pidlRoot As Long
     pszDisplayName As String
     lpszTitle As String
     ulFlags As Long
     lpfn As Long
     lParam As Long
     iImage As Long
    End Type

    Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
               "SHGetPathFromIDListA" (ByVal pidl As Long, _
               ByVal pszPath As String) As Boolean
               
    Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
               "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
               As Long


               
    #End If
               
    Private Const BIF_RETURNONLYFSDIRS = &H1


    Public Function BrowseFolder(szDialogTitle As String) As String
     Dim X As Long, bi As BROWSEINFO, dwIList As Long
     Dim szPath As String, wPos As Integer
     
       With bi
           .hOwner = hWndAccessApp
           .lpszTitle = szDialogTitle
           .ulFlags = BIF_RETURNONLYFSDIRS
       End With
       
       dwIList = SHBrowseForFolder(bi)
       szPath = Space$(512)
       X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
       
       If X Then
           wPos = InStr(szPath, Chr(0))
           BrowseFolder = Left$(szPath, wPos - 1)
       Else
           BrowseFolder = vbNullString
       End If
    End Function
    '*********** Code End *****************

    'No seu Formulário em um botão.

    '**********************************************************
    Dim strFolderName As String
    strFolderName = BrowseFolder("Texto na janela do Windows")

       If Len(strFolderName) > 0 Then
           Me!SeuCampo= strFolderName
           ' Do something with the selected folder
       'Else
           'No folder chosen, or user canceled
       End If
    '**********************************************************

    Noobezinho
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3632
    Registrado : 29/06/2012

    Re: [Resolvido]Salvar o caminho de uma pasta através da janela de localizar do windows

    Mensagem  Noobezinho em Dom Mar 04, 2018 10:14 pm

    Wellington

    Que bom que resolveu!

    Valeu pelo retorno!

    Agora, só falta o Resolvido no título do tópico.

    Para isso, edite uma mensagem tua e clique no botão Resolvido, ali embaixo da página, no lado direito.

    Se tiver dúvida, veja na minha assinatura.

    Boa sorte!
    avatar
    wearaujo
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 20
    Registrado : 04/02/2010

    Re: [Resolvido]Salvar o caminho de uma pasta através da janela de localizar do windows

    Mensagem  wearaujo em Dom Mar 04, 2018 10:20 pm

    Noobezinho estranho no meu não esta aparecendo este Botão de resolvido mais....ja abri em dois navegadores aqui e nada, por que sera...

    Noobezinho
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3632
    Registrado : 29/06/2012

    Re: [Resolvido]Salvar o caminho de uma pasta através da janela de localizar do windows

    Mensagem  Noobezinho em Dom Mar 04, 2018 10:28 pm

    Eu coloque pra você.

    Veja [Você precisa estar registrado e conectado para ver este link.].

    A imagem mostra onde o botão Resolvido está na página de edição de mensagens.

    [ ]'s


      Data/hora atual: Sex Jul 20, 2018 11:45 am