API para Selecionar Pastas

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