Função GetOpenFileName para Office 64-bit

No artigo anterior, criei uma função BrowseFolder (equivalente à API BrowseFolder do Windows) para ser usada tanto em Office 32-bit como em Office 64-bit. Agora neste artigo mostro como fazer a migração da função GetOpenFileName (http://access.mvps.org/access/api/api0001.htm), que abre a janela de diálogo do Windows para o usuário selecionar um (ou múltiplos) arquivos. Utilizei novamente o objeto FileDialog do Office, compatível com as versões 32-bit e 64-bit.

Ao contrário da função BrowseFolder, optei por mudar a sintaxe e os parâmetros da GetOpenFileName, pois eu não gostava da implementação original (que usava constantes públicas para as opções do diálogo, e requeria uma função auxiliar para preparar o filtro de arquivos). Preferi transformar as opções do diálogo em argumentos da função, e a definição dos filtros de tipo de arquivo em duas strings separadas por pipes (“|”).

A função ficou assim:

Public Function GetOpenFileName(blnAllowMultiSelect As Boolean, strFiltersDesc As String, strFiltersExt As String, _
intDefaultFilter As Integer, strDefaultFolder As String, strTitle As String) As String
'Informações dos argumentos:
'strFiltersDesc = passar a descrição dos tipos de arquivo separada por pipe. Exemplo:
'"Arquivos Excel (*.xls,*.xlsx,*.xlsm,*.xlsb)|Arquivos CSV (*.csv)"
'strFiltersDesc = passar os grupos de extensão dos tipos de arquivo separados por pipe. Exemplo:
'"*.xls;*.xlsx;*.xlsm;*.xlsb|*.csv"
'intDefaultFilter: código do filtro padrão, começando por 1.
'strDefaultFolder: se o valor terminar por "\", entende como pasta padrão. Caso contrário, pasta padrão e início do nome do arquivo.
Dim dlg As Object
Dim varArrayFilterDesc As Variant
Dim varArrayFilterExt As Variant
Dim intQtFilter As Integer
Dim i As Integer
Dim strReturn As String

On Error GoTo ErrHandler

Set dlg = Application.FileDialog(3) 'msoFileDialogFilePicker = 3

'Matriz de descrição de filtro
varArrayFilterDesc = Split(strFiltersDesc, "|")
varArrayFilterExt = Split(strFiltersExt, "|")
If UBound(varArrayFilterDesc) >= UBound(varArrayFilterExt) Then
    intQtFilter = UBound(varArrayFilterExt)
Else
    intQtFilter = UBound(varArrayFilterDesc)
End If

With dlg
    .AllowMultiSelect = blnAllowMultiSelect
    For i = 0 To intQtFilter
        .Filters.Add varArrayFilterDesc(i), varArrayFilterExt(i)
    Next i
    .FilterIndex = intDefaultFilter
    .InitialFileName = strDefaultFolder
    .Title = strTitle
    .Show
    For i = 1 To .SelectedItems.Count
        strReturn = strReturn & .SelectedItems(i) & ";"
    Next i
    If Len(strReturn) > 0 Then
        strReturn = Left(strReturn, Len(strReturn) - 1)
    End If
End With

GetOpenFileName = strReturn

ExitHere:
Exit Function

ErrHandler:
'MsgBox Err.Description & vbCrLf & Err.Number & vbCrLf & Err.Source, vbCritical, "GetOpenFile"
Err.Raise Err.Number, Err.Source, Err.Description
Resume ExitHere
Resume
End Function
Esse post foi publicado em Access, Excel, Office, VBA e marcado , , . Guardar link permanente.

Deixe uma resposta

Preencha os seus dados abaixo ou clique em um ícone para log in:

Logotipo do WordPress.com

Você está comentando utilizando sua conta WordPress.com. Sair / Alterar )

Imagem do Twitter

Você está comentando utilizando sua conta Twitter. Sair / Alterar )

Foto do Facebook

Você está comentando utilizando sua conta Facebook. Sair / Alterar )

Foto do Google+

Você está comentando utilizando sua conta Google+. Sair / Alterar )

Conectando a %s