MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

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
    avatar
    JPaulo
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 9255
    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


    .................................................................................
    Contribua com o maximoaccess, ajude a melhorar este que é o seu site na NET.

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

    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: Sab 24 Jun 2017, 06:17