API para Selecionar Pastas

Função de Depreciação de Patrimônio - BD
Função de Depreciação de Patrimônio – BD
8 de março de 2011
Agrupamento Automático de Dados com VBA
Agrupamento Automático de Dados com VBA
12 de março de 2011

Objetivo: Demonstrar a utilização da API de seleção de pastas do Windows com VBA.

Assim como vimos em outro post sobre API’s, o Windows permite que nós utilizemos diversas de suas funções por meio de programação, que de outra forma seria muito difícil desenvolvermos.

Neste código VBA você pode chamar a tela de seleção de pastas do Windows e após selecioná-la retornar este caminho, que pode ser utilizada para definir por exemplo o local aonde serão gerados arquivos a partir da sua planilha.

Para incluir uma procedimentos ou funções globais faça conforme o artigo http://guiadoexcel.com.br/criando-funcoes-proprias-globais.


'Colocar esta parte do código no início do módulo
Public Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
    "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
    "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) _
    As Long
Public 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

'Função que faz chamada da API
Public Function gfSelecionarPasta(ByVal vFolder As String, Optional Title As String, Optional hWnd) As String

    Dim bi As BROWSEINFO
    Dim pidl As Long
    Dim folder As String

    folder = String$(255, Chr$(0))

    With bi
        If IsNumeric(hWnd) Then .hOwner = hWnd
        .pidlRoot = 0
        If Title <> "" Then
            .lpszTitle = Title & Chr$(0)
        Else
            .lpszTitle = "Select a Folder" & Chr$(0)
        End If
    End With

    pidl = SHBrowseForFolder(bi)

    If SHGetPathFromIDList(ByVal pidl, ByVal folder) Then
        folder = Left(folder, InStr(folder, Chr$(0)) - 1)
    Else
        folder = ""
    End If

    If Right(folder, 1) <> "\" And Len(folder) > 0 Then folder = folder & "\"

    gfSelecionarPasta = folder

End Function

'Utilização da função para mostrar em um messageBox e colocar em uma célula o caminho da pasta
Public Sub gsPasta()
    Dim lPasta As String

    lPasta = gfSelecionarPasta("C:", "Selecione o local aonde será gravado o arquivo:")

    MsgBox "O arquivo será gravado em: " & lPasta, vbExclamation, "Local"

    Cells(1, 1).Value = lPasta
End Sub

Abraço

Marcos Rieper


Clique aqui e leia mais sobre Excel VBA. https://www.guiadoexcel.com.br/vba/ O Guia do Excel foi criado por Marcos Rieper e oferece artigos, dicas, tutoriais e modelos de planilhas prontas. Aqui você encontra tudo sobre Excel, seja de nível básico, intermediário,  avançado e VBA. O Guia do Excel oferece diversos materiais completamente gratuitos para download. Navegue em nosso site e confira! Conheça também a nossa Loja do Excel https://loja.guiadoexcel.com.br/
Cursos

Curso Excel Completo – Curso Excel Básico + Curso Excel Avançado – Acesso Vitalício

R$218,00 R$179,00

COMPRAR
Cursos

Curso Excel Master – Curso Excel Básico + Curso Excel Avançado + Curso VBA Excel + LP – Acesso Vitalício

R$357,00 R$249,00

COMPRAR
Cursos

Curso Excel PRO – Curso Excel Avançado + Curso VBA Excel + Lógica de programação – Acesso Vitalício

R$258,00 R$199,00

COMPRAR
Cursos

Curso Excel Web – Curso VBA Excel + Lógica de programação + Curso Web Scraping VBA- Acesso Vitalício

R$388,90 R$309,00

COMPRAR

2 Comentários

  1. wesley Patrick disse:

    Muito Obrigado, consegui o que estava procurando a tempos… que Deus te abençõe…

  2. Luciano disse:

    Muito obrigado, fantástico. Acabei de melhorar meu projeto com isso. Vlw.

Deixe uma resposta

O seu endereço de e-mail não será publicado. Campos obrigatórios são marcados com *

Esse site utiliza o Akismet para reduzir spam. Aprenda como seus dados de comentários são processados.

Inscreva-se no nosso canal do Youtube!


Junte-se ao nosso canal do Youtube. Começamos em abril de 2016, mas já temos mais de 06:00 h de treinamentos gratuitos e este número irá aumentar. Vídeos novos todos os sábados.