MaximoAccess

Caro Usuário, não tire as suas duvidas nas Salas de Repositório, abra sempre um novo tópico relacionado, nas salas destinadas para o efeito, como Sala de Tabelas, Consultas, Formulários, Relatórios, Macros, Módulos e VBA.

Obrigado

Administração do MaximoAccess

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    [Resolvido]Acionar a janela "Abrir arquivo" do windows através de VBA

    Compartilhe

    sergiojcardoso
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 17
    Registrado : 21/10/2013

    [Resolvido]Acionar a janela "Abrir arquivo" do windows através de VBA

    Mensagem  sergiojcardoso em Qui 17 Mar 2016, 17:19

    Olá pessoal

    Tenho um formulário de cadastro de equipamentos e máquinas.´
    Estes equipamentos tem seus manuais em PDF em uma pasta no disco rígido
    Um dos campos do formulário é o endereço do arquivo como hiperlink
    Acontece que, para preencher este campo, queria que ao clicar um botão, abrisse a janela "Abrir Arquivo" do windows
    Já fazia isso no access 2010 32 bits, mas no 2013 64 o botão nem funciona.

    O código da ação "Ao clicar" do botão é

    Private Sub Comando25_Click()
    On Error Resume Next
    Dim strFilter As String
    Dim strInputFileName As String

    strFilter = ahtAddFilterItem(strFilter, "(*.*)", "*.*")

    strInputFileName = ahtCommonFileOpenSave(Filter:=strFilter, OpenFile:=True, _
    DialogTitle:="Selecione o arquivo ou pasta ...", _
    Flags:=ahtOFN_HIDEREADONLY)
    If strInputFileName <> "" Then
    Link = strInputFileName
    Me.LocalManual = Link
    ElseIf strInputFileName = "" Then
    Exit Sub
    End If
    End Sub


    A função "ahtCommonFileOpenSave" que é acionado por ele é:

    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
    Dim OFN As tagOPENFILENAME
    Dim strFileName As String
    Dim strFileTitle As String
    Dim fResult As Boolean
    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
    strFileName = Left(FileName + String(256, 0), 256)
    strFileTitle = String(256, 0)
    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
    .hInstance = 0
    .strCustomFilter = ""
    .nMaxCustFilter = 0
    .lpfnHook = 0
    .strCustomFilter = String(255, 0)
    .nMaxCustFilter = 255
    End With
    If OpenFile Then
    fResult = aht_apiGetOpenFileName(OFN)
    Else
    fResult = aht_apiGetSaveFileName(OFN)
    End If
    If fResult Then
    If Not IsMissing(Flags) Then Flags = OFN.Flags
    ahtCommonFileOpenSave = TrimNull(OFN.strFile)
    Else
    ahtCommonFileOpenSave = vbNullString
    End If
    End Function

    Alguen sabe me dizer porque em 64 bits não está funcionando?

    Obrigado antecipadamente

    JPaulo
    Moderador
    Moderador

    Respeito às Regras 100%

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

    Re: [Resolvido]Acionar a janela "Abrir arquivo" do windows através de VBA

    Mensagem  JPaulo em Sex 18 Mar 2016, 15:32

    Não é essa função que não funciona no 64 bits, é a API que é chamada por essa função.

    Você tem de ter uma API de nome "aht_apiGetOpenFileName" e para o 64 bits tem de adicionar o "PtrSafe"

    Exemplo;
    Public Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias _
    "GetOpenFileNameA" (OFN As OPENFILENAME) As Long


    .................................................................................
    Sucesso e Bons Estudos
    Success and Good Studies

    [Você precisa estar registrado e conectado para ver esta imagem.] [Você precisa estar registrado e conectado para ver este link.]
    [Você precisa estar registrado e conectado para ver esta imagem.] [Você precisa estar registrado e conectado para ver este link.]
    [Você precisa estar registrado e conectado para ver esta imagem.] [Você precisa estar registrado e conectado para ver este link.]

    sergiojcardoso
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 17
    Registrado : 21/10/2013

    Acionar a janela "Abrir arquivo" do windows através de VBA - Resolvido

    Mensagem  sergiojcardoso em Sab 19 Mar 2016, 00:07

    Olá JPaulo,

    Entendi o que você disse.
    Realmente tenho um modulo que tem este API, mas já tinha inserido o "PtrSafe"
    Não funcionou também

    Mas, fiz por um outro caminho e funcionou.

    Dim CxDialog As Office.FileDialog

    Set CxDialog = Application.FileDialog(msoFileDialogFilePicker)
    With CxDialog

    .AllowMultiSelect = False

    ' definir o titulo da caixa de dialogo
    .Title = "Seleccione uma imagem"

    'limpar os filtros
    .Filters.Clear

    'adicionar novos filtros
    '.Filters.Add "JPG", "*.jpg"
    '.Filters.Add "BMP", "*.bmp"
    .Filters.Add "Todos os arquivos", "*.*"

    'mostrar a caixa de dialogo
    If .Show = True Then ' se algum arquivo tiver sido escolhido
    'atribui o endereço do manual ao campo link
    Me.LocalManual = .SelectedItems(1)

    End If


    Ai funcionou perfeitamente

    Mas obrigado pela atenção

      Data/hora atual: Sex 09 Dez 2016, 09:33