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


2 participantes

    [Resolvido]Abrir função BrowseForFolder em determinada pasta

    avatar
    Junior Meireles
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 56
    Registrado : 14/08/2010

    [Resolvido]Abrir função BrowseForFolder em determinada pasta Empty [Resolvido]Abrir função BrowseForFolder em determinada pasta

    Mensagem  Junior Meireles 16/12/2013, 15:42

    Amigos, encontrei esta função para abrir pastas e
    minha dúvida é se teria como ao abrí-la, ir para uma
    determinada pasta, como por exemplo:

    D:\Certificado Escritorio Conectividade Social

    ou

    D:\ArquivosXML

    Pois sempre que ela é executada vai para "Meu computador"

    Obrigado


    Option Compare Database
    Option Explicit

    Private Type BROWSEINFO
    hWndOwner As Long
    pidlRoot As Long
    pszDisplayName As Long
    lpszTitle As Long
    ulFlags As Long
    lpfnCallback As Long
    lParam As Long
    iImage As Long
    End Type

    'Navegando para o diretório..
    Private Const BIF_RETURNONLYFSDIRS = &H1 '&H1 'para localizar uma pasta para _
    Inicie a pesquisa do documento.
    Private Const BIF_DONTGOBELOWDOMAIN = &H2 '&H2 'para iniciar a localizar _
    Computador.
    Private Const BIF_STATUSTEXT = &H4
    Private Const BIF_RETURNFSANCESTORS = &H8

    Private Const BIF_BROWSEFORCOMPUTER = &H1000 'navegando para computadores.
    Private Const BIF_BROWSEFORPRINTER = &H2000 'navegando para impressoras.
    Private Const BIF_BROWSEINCLUDEFILES = &H4000 'navegando para tudo.

    Private Const MAX_PATH = 260

    Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
    Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal _
    lpString1 As String, ByVal lpString2 As String) As Long

    Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As _
    BROWSEINFO) As Long
    Private Declare Function SHGetPathFromIDList Lib "shell32" ( _
    ByVal pidList As Long, ByVal lpBuffer As String) As Long

    Public Function BrowseForFolder(hWndOwner As Long, _
    sPrompt As String) As String

    '=======================================================
    'Abre a caixa de diálogo do sistema para procurar pasta.
    '=======================================================
    Dim iNull As Integer
    Dim lpIDList As Long
    Dim lResult As Long
    Dim sPath As String
    Dim udtBI As BROWSEINFO

    With udtBI
    .hWndOwner = hWndOwner
    .lpszTitle = lstrcat(sPrompt, "")
    .ulFlags = BIF_RETURNONLYFSDIRS
    End With

    lpIDList = SHBrowseForFolder(udtBI)

    If lpIDList Then
    sPath = String$(MAX_PATH, 0)
    lResult = SHGetPathFromIDList(lpIDList, sPath)
    Call CoTaskMemFree(lpIDList)
    iNull = InStr(sPath, vbNullChar)

    If iNull Then
    sPath = Left$(sPath, iNull - 1)
    End If
    End If

    BrowseForFolder = sPath

    End Function


    Para Chamar a função estou usando:

    Private Sub cmdLocalizarDiretorio_Click()

    Dim MyStr As String
    MyStr = BrowseForFolder(0, "Salvar BD em:")


    End Sub
    JPaulo
    JPaulo
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 11016
    Registrado : 04/11/2009

    [Resolvido]Abrir função BrowseForFolder em determinada pasta Empty Re: [Resolvido]Abrir função BrowseForFolder em determinada pasta

    Mensagem  JPaulo 16/12/2013, 16:28

    Se for somente para abrir uma determinada pasta, como diz no seu título do tópico, não necessita de todo esse código;


    Private Sub SeuBotão_Click()
    Dim x As Variant
       x = Shell("EXPLORER.EXE D:\Certificado Escritorio Conectividade Social\", vbNormalFocus)
    End Sub


    .................................................................................
    Contribua com o maximoaccess nos links abaixo, ajude a melhorar este que é o seu site na NET.

    Pay-Pal R$ Aqui
    Pay-Pal € Aqui

    Ou ainda: Aqui (Novo)

    Sucesso e Bons Estudos
    Success and Good Studies

    [Resolvido]Abrir função BrowseForFolder em determinada pasta Folder_announce_new Utilize o Sistema de Busca do Fórum...
    [Resolvido]Abrir função BrowseForFolder em determinada pasta Folder_announce_new 102 Códigos VBA Gratuitos...
    [Resolvido]Abrir função BrowseForFolder em determinada pasta Folder_announce_new Instruções SQL como utilizar...
    avatar
    Junior Meireles
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 56
    Registrado : 14/08/2010

    [Resolvido]Abrir função BrowseForFolder em determinada pasta Empty Re: [Resolvido]Abrir função BrowseForFolder em determinada pasta

    Mensagem  Junior Meireles 16/12/2013, 17:05

    JPaulo,
    Obrigado pelo seu interesse,
    este comando funciona, mas no meu
    projeto renomeio alguns arquivos e o caminhho deles é procurado em um formulário
    no qual quando chamo esta função fica gravado no formulario o ultimo caminho
    percorrido.

    Seria como se está função me abrisse na última pasta selecionada, teria como?


    Obrigado
    JPaulo
    JPaulo
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 11016
    Registrado : 04/11/2009

    [Resolvido]Abrir função BrowseForFolder em determinada pasta Empty Re: [Resolvido]Abrir função BrowseForFolder em determinada pasta

    Mensagem  JPaulo 17/12/2013, 11:11

    Essa API nunca usei, esta sei que funfa;


    Num modulo:

    Option Explicit

    Private Declare Function SHBrowseForFolder Lib "shell32" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
    Private Declare Function SHGetPathFromIDList Lib "shell32" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
    ByVal pszPath As String) As Long
    Private Declare Function GetForegroundWindow Lib "user32" () As Long
    Private Declare Sub CoTaskMemFree Lib "ole32" (ByVal pv As Long)
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
    ByVal wParam As Long, lParam As Any) As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)

    Private Declare Function LocalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal uBytes As Long) As Long
    Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long

    Private Const MAX_PATH = 260

    Private Const BIF_RETURNONLYFSDIRS = 1
    Private Const BIF_NEWDIALOGSTYLE = &H40

    Private Const BFFM_INITIALIZED As Long = 1
    Private Const BFFM_SELCHANGED As Long = 2
    Private Const BFFM_VALIDATEFAILED As Long = 3

    Private Const WM_USER = &H400

    Private Const BFFM_SETSTATUSTEXT As Long = (WM_USER + 100)
    Private Const BFFM_ENABLEOK As Long = (WM_USER + 101)
    Private Const BFFM_SETSELECTION As Long = (WM_USER + 102)

    Private Const LMEM_FIXED = &H0
    Private Const LMEM_ZEROINIT = &H40

    Private Const LPTR = (LMEM_FIXED Or LMEM_ZEROINIT)

    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

    Public Function GetFolder(ByVal title As String, ByVal start As String, ByVal newfolder As Boolean) As String
    Dim BI As BROWSEINFO, pidl As Long, lpSelPath As Long
    Dim spath As String * MAX_PATH

    'fill in the info it needs
    With BI
    .hOwner = GetForegroundWindow
    .pidlRoot = 0
    .lpszTitle = title
    .lpfn = FARPROC(AddressOf BrowseCallbackProcStr)
    .ulFlags = BIF_RETURNONLYFSDIRS
    If newfolder = True Then .ulFlags = BIF_RETURNONLYFSDIRS + BIF_NEWDIALOGSTYLE
    lpSelPath = LocalAlloc(LPTR, Len(start) + 1)
    CopyMemory ByVal lpSelPath, ByVal start, Len(start) + 1
    .lParam = lpSelPath
    End With

    'get the idlist long from the returned folder
    pidl = SHBrowseForFolder(BI)

    'do then if they clicked ok
    If pidl Then
    If SHGetPathFromIDList(pidl, spath) Then
    'next line is the returned folder
    GetFolder = Left$(spath, InStr(spath, vbNullChar) - 1)
    End If
    Call CoTaskMemFree(pidl)
    Else
    'user clicked cancel
    End If

    Call LocalFree(lpSelPath)

    End Function

    Public Function BrowseCallbackProcStr(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long
    Dim spath As String, bFlag As Long

    spath = Space$(MAX_PATH)

    Select Case uMsg
    Case BFFM_INITIALIZED
    Call SendMessage(hWnd, BFFM_SETSELECTION, 1, ByVal lpData)
    Case BFFM_SELCHANGED
    If SHGetPathFromIDList(lParam, spath) Then
    spath = Left(spath, InStr(1, spath, Chr(0)) - 1)
    End If
    End Select

    End Function

    Public Function FARPROC(pfn As Long) As Long
    FARPROC = pfn
    End Function


    Para usar num botão do seu formulario:

    Private Sub SeuBotão_Click()
    Dim MinhaPasta As String
    MinhaPasta = GetFolder("Salvar BD em:", "D:\ArquivosXML", True)
    End Sub


    .................................................................................
    Contribua com o maximoaccess nos links abaixo, ajude a melhorar este que é o seu site na NET.

    Pay-Pal R$ Aqui
    Pay-Pal € Aqui

    Ou ainda: Aqui (Novo)

    Sucesso e Bons Estudos
    Success and Good Studies

    [Resolvido]Abrir função BrowseForFolder em determinada pasta Folder_announce_new Utilize o Sistema de Busca do Fórum...
    [Resolvido]Abrir função BrowseForFolder em determinada pasta Folder_announce_new 102 Códigos VBA Gratuitos...
    [Resolvido]Abrir função BrowseForFolder em determinada pasta Folder_announce_new Instruções SQL como utilizar...
    avatar
    Junior Meireles
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 56
    Registrado : 14/08/2010

    [Resolvido]Abrir função BrowseForFolder em determinada pasta Empty Re: [Resolvido]Abrir função BrowseForFolder em determinada pasta

    Mensagem  Junior Meireles 17/12/2013, 14:16

    JPaulo,

    Mais uma vez obrigado, funfou certinho, como precisava

    Valeu mesmo!
    JPaulo
    JPaulo
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 11016
    Registrado : 04/11/2009

    [Resolvido]Abrir função BrowseForFolder em determinada pasta Empty Re: [Resolvido]Abrir função BrowseForFolder em determinada pasta

    Mensagem  JPaulo 17/12/2013, 14:47

    Obrigado pelo retorno o forum agradece.


    .................................................................................
    Contribua com o maximoaccess nos links abaixo, ajude a melhorar este que é o seu site na NET.

    Pay-Pal R$ Aqui
    Pay-Pal € Aqui

    Ou ainda: Aqui (Novo)

    Sucesso e Bons Estudos
    Success and Good Studies

    [Resolvido]Abrir função BrowseForFolder em determinada pasta Folder_announce_new Utilize o Sistema de Busca do Fórum...
    [Resolvido]Abrir função BrowseForFolder em determinada pasta Folder_announce_new 102 Códigos VBA Gratuitos...
    [Resolvido]Abrir função BrowseForFolder em determinada pasta Folder_announce_new Instruções SQL como utilizar...

    Conteúdo patrocinado


    [Resolvido]Abrir função BrowseForFolder em determinada pasta Empty Re: [Resolvido]Abrir função BrowseForFolder em determinada pasta

    Mensagem  Conteúdo patrocinado


      Data/hora atual: 29/3/2024, 01:09