Chamando a caixa de diálogo Abrir/Salvar como

Isto pode ser feito usando o Controle Common Dialog do Access ou usando a API definida para isso.

Autor: Ken Getz

Para chamar a caixa de diálogo a partir do seu código, veja a função TestIt() no módulo ou use o seguinte exemplo como guia.

Dim strFilter As String
Dim strInputFileName as string

strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.XLS)", "*.XLS")
strInputFileName = ahtCommonFileOpenSave( _
                Filter:=strFilter, OpenFile:=True, _
                DialogTitle:="Please select an input file...", _
                Flags:=ahtOFN_HIDEREADONLY)

Note que, para chamar a caixa de diálogo Salvar Como, devemos usar a mesma função, apenas alterando a opção OpenFile para False. Por exemplo:

'Pede o nome do arquivo a ser salvo:

strFilter = ahtAddFilterItem(myStrFilter, "Excel Files (*.xls)", "*.xls")
strSaveFileName = ahtCommonFileOpenSave( _
                                    OpenFile:=False, _         
                                    Filter:=strFilter, _
                    Flags:=ahtOFN_OVERWRITEPROMPT Or ahtOFN_READONLY)

'***************** Início do código **************
'este código foi escrito originalmente por by Ken Getz.
'Ele não deve ser alterado ou distribuído,
'exceto como parte de um aplicativo.
'Use-o livremente em qualquer aplicativo,
'desde que esta nota de copyright fique inalterada.
'
' Código cortesia de :
' Microsoft Access 95 How-To
' Ken Getz e Paul Litwin
' Waite Group Press, 1996

Type tagOPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    strFilter As String
    strCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    strFile As String
    nMaxFile As Long
    strFileTitle As String
    nMaxFileTitle As Long
    strInitialDir As String
    strTitle As String
    Flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    strDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Declare Function aht_apiGetOpenFileName Lib "comdlg32.dll" _
    Alias "GetOpenFileNameA" (OFN As tagOPENFILENAME) As Boolean

Declare Function aht_apiGetSaveFileName Lib "comdlg32.dll" _
    Alias "GetSaveFileNameA" (OFN As tagOPENFILENAME) As Boolean
Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long

Global Const ahtOFN_READONLY = &H1
Global Const ahtOFN_OVERWRITEPROMPT = &H2
Global Const ahtOFN_HIDEREADONLY = &H4
Global Const ahtOFN_NOCHANGEDIR = &H8
Global Const ahtOFN_SHOWHELP = &H10
' You won't use these.
'Global Const ahtOFN_ENABLEHOOK = &H20
'Global Const ahtOFN_ENABLETEMPLATE = &H40
'Global Const ahtOFN_ENABLETEMPLATEHANDLE = &H80
Global Const ahtOFN_NOVALIDATE = &H100
Global Const ahtOFN_ALLOWMULTISELECT = &H200
Global Const ahtOFN_EXTENSIONDIFFERENT = &H400
Global Const ahtOFN_PATHMUSTEXIST = &H800
Global Const ahtOFN_FILEMUSTEXIST = &H1000
Global Const ahtOFN_CREATEPROMPT = &H2000
Global Const ahtOFN_SHAREAWARE = &H4000
Global Const ahtOFN_NOREADONLYRETURN = &H8000
Global Const ahtOFN_NOTESTFILECREATE = &H10000
Global Const ahtOFN_NONETWORKBUTTON = &H20000
Global Const ahtOFN_NOLONGNAMES = &H40000
' Novo no Windows 95
Global Const ahtOFN_EXPLORER = &H80000
Global Const ahtOFN_NODEREFERENCELINKS = &H100000
Global Const ahtOFN_LONGNAMES = &H200000

Function TestIt()
    Dim strFilter As String
    Dim lngFlags As Long
    strFilter = ahtAddFilterItem(strFilter, "Arquivos Access (*.mda, *.mdb)", _
                    "*.MDA;*.MDB")
    strFilter = ahtAddFilterItem(strFilter, "Arquivos dBASE (*.dbf)", "*.DBF")
    strFilter = ahtAddFilterItem(strFilter, "Arquivos Texto (*.txt)", "*.TXT")
    strFilter = ahtAddFilterItem(strFilter, "Todos os arquivos (*.*)", "*.*")
    MsgBox "Você selecionou: " & ahtCommonFileOpenSave(InitialDir:="C:\", _
        Filter:=strFilter, FilterIndex:=3, Flags:=lngFlags, _
        DialogTitle:="Olá! Abra-me!")
    ' Como você passou uma variável para lngFlags,
    ' A função coloca os valores dos flags de retorno na variável.
    Debug.Print Hex(lngFlags)
End Function

Function GetOpenFile(Optional varDirectory As Variant, _
    Optional varTitleForDialog As Variant) As Variant
' Aqui está um exemplo que obtém o nome de um banco de dados Access.
Dim strFilter As String
Dim lngFlags As Long
Dim varFileName As Variant
' Especifica que o arquivo selecionado deve existir,
' não altere diretórios ao terminar
' Além disso, não se preocupe em mostrar
' a caixa panas leitura para não confundir os usuários.
    lngFlags = ahtOFN_FILEMUSTEXIST Or _
                ahtOFN_HIDEREADONLY Or ahtOFN_NOCHANGEDIR
    If IsMissing(varDirectory) Then
        varDirectory = ""
    End If
    If IsMissing(varTitleForDialog) Then
        varTitleForDialog = ""
    End If

    ' Define i string de filtro e aloca espaço na string "c".
    ' Duplicar esta linha com alterações necessárias
    ' para mais templates de arquivos.
    strFilter = ahtAddFilterItem(strFilter, _
                "Access (*.mdb)", "*.MDB;*.MDA")
    ' Faz a chamada para obter o nome de arquivo.
    varFileName = ahtCommonFileOpenSave( _
                    OpenFile:=True, _
                    InitialDir:=varDirectory, _
                    Filter:=strFilter, _
                    Flags:=lngFlags, _
                    DialogTitle:=varTitleForDialog)
    If Not IsNull(varFileName) Then
        varFileName = TrimNull(varFileName)
    End If
    GetOpenFile = varFileName
End Function

Function ahtCommonFileOpenSave( _
            Optional ByRef Flags As Variant, _
            Optional ByVal InitialDir As Variant, _
            Optional ByVal Filter As Variant, _
            Optional ByVal FilterIndex As Variant, _
            Optional ByVal DefaultExt As Variant, _
            Optional ByVal FileName As Variant, _
            Optional ByVal DialogTitle As Variant, _
            Optional ByVal hwnd As Variant, _
            Optional ByVal OpenFile As Variant) As Variant
' Este é o ponto de entrada usado para chamar a caixa de diálogo
' Abrir/Salvar Arquivo. os parâmetros estão listados 
' abaixo e são todos opcionais.
'
' Entrada:
' Flags: Uma ou mais das constantes ahtOFN_*, usando OR para concatená-las.
' InitialDir: O diretório onde deve ser feita a busca inicial.
' Filter: Conjunto de filtros de arquivos, indicados na chamada 
'         AddFilterItem. Veja exemplos.
' FilterIndex: Inteiro baseado em 1- que indica quaisa filtros devem 
'              ser usados como padrão (1 se nada for especificado.
' DefaultExt: Extensão a ser usada se o usuário não especificar nenhuma.
'             Útil apenas ao salvar arquivos.
' FileName: Valor padrão para a caixa de nome de arquivo.
' DialogTitle: Título da caixa de diálogo.
' hWnd: Handle da janela principale
' OpenFile: Booleano (True=Abre arquivo/False=Calvar como)
'
' Saida:
' Valor devolvido: Ou Null ou o nome do arquivo selecionado.

Dim OFN As tagOPENFILENAME
Dim strFileName As String
Dim strFileTitle As String
Dim fResult As Boolean
    ' Dá um título à caixa de diálogo.
    If IsMissing(InitialDir) Then InitialDir = CurDir
    If IsMissing(Filter) Then Filter = ""
    If IsMissing(FilterIndex) Then FilterIndex = 1
    If IsMissing(Flags) Then Flags = 0&
    If IsMissing(DefaultExt) Then DefaultExt = ""
    If IsMissing(FileName) Then FileName = ""
    If IsMissing(DialogTitle) Then DialogTitle = ""
    If IsMissing(hwnd) Then hwnd = Application.hWndAccessApp
    If IsMissing(OpenFile) Then OpenFile = True
    ' Aloca espaço na string para as strings devolvidas.
    strFileName = Left(FileName & String(256, 0), 256)
    strFileTitle = String(256, 0)
    ' Monta a estrutura de dados antes de chamar a função.
    With OFN
        .lStructSize = Len(OFN)
        .hwndOwner = hwnd
        .strFilter = Filter
        .nFilterIndex = FilterIndex
        .strFile = strFileName
        .nMaxFile = Len(strFileName)
        .strFileTitle = strFileTitle
        .nMaxFileTitle = Len(strFileTitle)
        .strTitle = DialogTitle
        .Flags = Flags
        .strDefExt = DefaultExt
        .strInitialDir = InitialDir
        ' Não pensei que alguém pudesse usar estas opções.
        .hInstance = 0
        '.strCustomFilter = ""
        '.nMaxCustFilter = 0
        .lpfnHook = 0
        'New for NT 4.0
        .strCustomFilter = String(255, 0)
        .nMaxCustFilter = 255
    End With
    ' Isto passa as estruturas de dados desejadas para a
    ' API do Windows, que, por sua vez, as usa para apresentar
    ' a caixa de diálogo Abrir/Salvar Como.
    If OpenFile Then
        fResult = aht_apiGetOpenFileName(OFN)
    Else
        fResult = aht_apiGetSaveFileName(OFN)
    End If

    ' A chamada à função preencheu o membro strFileTitle
    ' da estrutura. É necessário escrever código especial
    ' para recuperar as informações, se desejado.
    If fResult Then
        ' Devemos tomar cuidado e verificar o membro Flags da 
        ' estrutura para obter informações sobre o arquivo selecionado.
        ' Neste exemplo, se você se preocupou em passar um valor
        ' em Flags, vamos preenche-lo com o valor de saída de Flag.
        If Not IsMissing(Flags) Then Flags = OFN.Flags
        ahtCommonFileOpenSave = TrimNull(OFN.strFile)
    Else
        ahtCommonFileOpenSave = vbNullString
    End If
End Function

Function ahtAddFilterItem(strFilter As String, _
    strDescription As String, Optional varItem As Variant) As String
' Insere um novo pedaço no filtro de arquivos.
' Ou seja, pega o valor anterior e coloca na desrição,
' (como "Bancos de dados"), um caracter nulo, o esqueleto
' (como"*.mdb;*.mda") e um caracter nulo final.

    If IsMissing(varItem) Then varItem = "*.*"
    ahtAddFilterItem = strFilter & _
                strDescription & vbNullChar & _
                varItem & vbNullChar
End Function

Private Function TrimNull(ByVal strItem As String) As String
Dim intPos As Integer
    intPos = InStr(strItem, vbNullChar)
    If intPos > 0 Then
        TrimNull = Left(strItem, intPos - 1)
    Else
        TrimNull = strItem
    End If
End Function
'************** Final do código *****************