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]Conversão de codigo para office 365

    Compartilhe

    xikutuga
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 84
    Registrado : 07/08/2013

    [Resolvido]Conversão de codigo para office 365

    Mensagem  xikutuga em 12/9/2018, 15:58

    Boa tarde a todos,

    num dos meus formulários tinha o código, que transcrevo em baixo, que funcionava na perfeição para o efeito que é ao carregar num botão ele verifica se tinha um link de um ficheiro em pdf ou em zip numa determinada pasta em rede e caso já existisse abria o ficheiro caso contrario dava para pesquisar e selecionar o ficheiro que posteriormente o abriria.....
    Acontece que agora no office 365 não funciona alguem me consegue ajudar... obrigado

    Código usado


    Código:
    Private Sub Comando11_Click()
    If IsNull(Me.link) Then
       Dim strFilter As String
       Dim strInputFileName As String
           strFilter = ahtAddFilterItem(strFilter, "Arquivos PDF", "*.pdf")
         
           
       Dim fs, F, S, Pasta 'Linha criada e adicionada por Thomas Jefferson Pereira Lopes (redcatmetal@aol.com)
         
       If IsNull(Me!link) Or Me!link = "" Then 'Linha criada e adicionada por Thomas Jefferson Pereira Lopes
           Pasta = "\\10.100.0.59\dados\Central_Compras\Arquivodados\" & Forms![Tbl_1]![Ano] & "\Orçamentos"
           'Linha criada e adicionada por Thomas Jefferson Pereira Lopes
           
       Else 'Linha criada e adicionada por Thomas Jefferson Pereira Lopes
       
           Set fs = CreateObject("Scripting.FileSystemObject") 'Linha criada e adicionada por Thomas Jefferson Pereira Lopes
           Set F = fs.GetFile(Me!link) 'Linha criada e adicionada por Thomas Jefferson Pereira Lopes
           Set Pasta = F.ParentFolder 'Linha criada e adicionada por Thomas Jefferson Pereira Lopes
       
       End If 'Linha criada e adicionada por Thomas Jefferson Pereira Lopes
           
       'A seguinte instrução sofreu uma alteração por Thomas Jefferson Pereira Lopes
       strInputFileName = ahtCommonFileOpenSave(Filter:=strFilter, InitialDir:=Pasta, _
       OpenFile:=True, DialogTitle:="Selecione o seu anexo", _
       flags:=ahtOFN_HIDEREADONLY)
       If IsNull(strInputFileName) Or strInputFileName = "" Then
       Me!link = Me!link
       Else
       Me!link = strInputFileName
       End If
    Else
       OpenFile = fHandleFile(link, WIN_NORMAL)
       'Me.viewer.LoadFile (Me.Link)
    End If
    End Sub


    Function ahtAddFilterItem(strFilter As String, _
       strDescription As String, Optional varItem As Variant) As String
       If IsMissing(varItem) Then varItem = "*.*"
       ahtAddFilterItem = strFilter & _
                   strDescription & vbNullChar & _
                   varItem & vbNullChar
    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
    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
           .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

    Ricardo Monteiro
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 46
    Registrado : 27/11/2017

    Re: [Resolvido]Conversão de codigo para office 365

    Mensagem  Ricardo Monteiro em 12/9/2018, 17:53

    Isso provavelmente é problema de biblioteca. Se você atualizou de um Office anterior para o 365, você precisa instalar as bibliotecas anteriores no seu office 365.

    xikutuga
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 84
    Registrado : 07/08/2013

    Re: [Resolvido]Conversão de codigo para office 365

    Mensagem  xikutuga em 14/9/2018, 09:18

    BOM DIA,

    obg pela resposta mas pelo k tenho lido deve-se ao facto ter sido feita em 32 bits e o novo acess e de 64 bits....

    Alguém sabe a solução para resolver a situação que não seja voltar a instalar o acess 32bits

    melhores cumprimentos...

    Ricardo Monteiro
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 46
    Registrado : 27/11/2017

    Re: [Resolvido]Conversão de codigo para office 365

    Mensagem  Ricardo Monteiro em 14/9/2018, 13:58

    Neste caso, dê uma olhada neste artigo:

    docs.microsoft.com/pt-br/office/vba/language/concepts/getting-started/64-bit-visual-basic-for-applications-overview#writing-code-that-works-on-both-32-bit-and-64-bit-office

    Até ontem tinha uma versão em português, traduzida por máquina, mas hoje não consegui acessar ela.
    avatar
    JPaulo
    Moderador
    Moderador

    Respeito às Regras 100%

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

    Re: [Resolvido]Conversão de codigo para office 365

    Mensagem  JPaulo em 14/9/2018, 14:09

    Fancisco, você para estar a trabalhar com o "tagOPENFILENAME", tem de ter uma ou mais API`s  nos módulos.
    Essas API`s chamam DLL`s 32 bits.

    Para resolver o seu problema terá de acrescentar o PtrSafe.

    Exemplo:

    Código:
    #If Win64 = 1 And VBA7 = 1 Then
        Declare PtrSafe Function aht_apiGetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (OFN As tagOPENFILENAME) As Boolean
    #Else
        Declare Function aht_apiGetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (OFN As tagOPENFILENAME) As Boolean
    #End If

    Verifique ainda se a DLL "comdlg32.dll" se encontra na pasta "C:\Windows\SysWoW64\"
    Mas apenas o exemplo acima deve funcionar.


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

    Pay-Pal R$ Aqui
    Pay-Pal € Aqui

    Ou ainda: Aqui (Novo)

    Sucesso e Bons Estudos
    Success and Good Studies

    Utilize o Sistema de Busca do Fórum...
    102 Códigos VBA Gratuitos...
    Instruções SQL como utilizar...

    xikutuga
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 84
    Registrado : 07/08/2013

    Re: [Resolvido]Conversão de codigo para office 365

    Mensagem  xikutuga em 14/9/2018, 17:01

    boa tarde,
    obrigado pela ajuda ja verifiquei e o comdlg32.dll" encontra-se na pasta "C:\Windows\SysWoW64\",mas pode por favor explicar onde coloco o código que me indicou.....

    obrigado
    avatar
    JPaulo
    Moderador
    Moderador

    Respeito às Regras 100%

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

    Re: [Resolvido]Conversão de codigo para office 365

    Mensagem  JPaulo em 14/9/2018, 17:17

    Você em algum modulo tem de ter as API`s.

    É só fazer o que lhe passei acima.


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

    Pay-Pal R$ Aqui
    Pay-Pal € Aqui

    Ou ainda: Aqui (Novo)

    Sucesso e Bons Estudos
    Success and Good Studies

    Utilize o Sistema de Busca do Fórum...
    102 Códigos VBA Gratuitos...
    Instruções SQL como utilizar...

    xikutuga
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 84
    Registrado : 07/08/2013

    Re: [Resolvido]Conversão de codigo para office 365

    Mensagem  xikutuga em 17/9/2018, 11:36

    Bom dia,

    Transcrevo o modulo onde penso que esta a api para o "tagOPENFILENAME" , mas não consigo colocar a funcionar pode  por favor explicar-me o que tenho de alterar?

    Obrigado.


    Código:
    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
           .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





    Option Compare Database
    Option Explicit


    Type tagOPENFILENAME
      lStructSize As Long
      hwndOwner As Long
      hInstance As Long
      lpstrFilter As String
      lpstrCustomFilter As String
      nMaxCustFilter As Long
      nFilterIndex As Long
      lpstrFile As String
      nMaxFile As Long
      lpstrFileTitle As String
      nMaxFileTitle As Long
      lpstrInitialDir As String
      lpstrTitle As String
      flags As Long
      nFileOffset As Integer
      nFileExtension As Integer
      lpstrDefExt As String
      lCustData As Long
      lpfnHook As Long
      lpTemplateName As String


    Declare PtrSafe Function apiGetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (OPENFILENAME As tagOPENFILENAME) As Long

    Dim OPENFILENAME As tagOPENFILENAME
    Public Const OFN_READONLY = &H1
    Public Const OFN_OVERWRITEPROMPT = &H2
    Public Const OFN_HIDEREADONLY = &H4
    Public Const OFN_NOCHANGEDIR = &H8
    Public Const OFN_SHOWHELP = &H10
    Public Const OFN_ENABLEHOOK = &H20
    Public Const OFN_ENABLETEMPLATE = &H40
    Public Const OFN_ENABLETEMPLATEHANDLE = &H80
    Public Const OFN_NOVALIDATE = &H100
    Public Const OFN_ALLOWMULTISELECT = &H200
    Public Const OFN_EXTENSIONDIFFERENT = &H400
    Public Const OFN_PATHMUSTEXIST = &H800
    Public Const OFN_FILEMUSTEXIST = &H1000
    Public Const OFN_CREATEPROMPT = &H2000
    Public Const OFN_SHAREAWARE = &H4000
    Public Const OFN_NOREADONLYRETURN = &H8000
    Public Const OFN_NOTESTFILECREATE = &H10000
    Public Const OFN_NONETWORKBUTTON = &H20000
    Public Const OFN_NOLONGNAMES = &H40000                      '  force no long names for 4.x modules
    Public Const OFN_EXPLORER = &H80000                         '  new look commdlg
    Public Const OFN_NODEREFERENCELINKS = &H100000
    Public Const OFN_LONGNAMES = &H200000                       '  force long names for 3.x modules

    Public Const OFN_SHAREFALLTHROUGH = 2
    Public Const OFN_SHARENOWARN = 1
    Public Const OFN_SHAREWARN = 0
    avatar
    JPaulo
    Moderador
    Moderador

    Respeito às Regras 100%

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

    Re: [Resolvido]Conversão de codigo para office 365

    Mensagem  JPaulo em 17/9/2018, 12:41

    Todo esse código está no mesmo módulo ???

    Não me parece correta a ordem, mas ainda faltam outros trechos.

    Se em vez de você usar essas API`s antigas e usar o "Application.FileDialog" vai funcionar em todas as versões.

    Veja este tópico;
    http://www.maximoaccess.com/t8306-resolvidouso-do-application-filedialog-para-selecao-de-arquivos


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

    Pay-Pal R$ Aqui
    Pay-Pal € Aqui

    Ou ainda: Aqui (Novo)

    Sucesso e Bons Estudos
    Success and Good Studies

    Utilize o Sistema de Busca do Fórum...
    102 Códigos VBA Gratuitos...
    Instruções SQL como utilizar...
    avatar
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 5672
    Registrado : 15/03/2013

    Re: [Resolvido]Conversão de codigo para office 365

    Mensagem  ahteixeira em 17/9/2018, 14:23

    Olá a todos,

    Francisco, a sugestão do nosso grande JPaulo acho a mais acertiva.
    Veja mais um casdo em que resolveu:
    http://www.maximoaccess.com/t33094-resolvidoerro-ao-anexar-fotos-64bit

    Abraço

    xikutuga
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 84
    Registrado : 07/08/2013

    Re: [Resolvido]Conversão de codigo para office 365

    Mensagem  xikutuga em 18/9/2018, 12:03

    Bom dia
    Após ler todos os conselhos se gui um deles e consegui adaptar a situação com um codigo muito simples que abaixo transcrevo. obrigado a todos
    abraço


    Private Sub Comando12_Click()
    On Error GoTo PROC_ERR
    If IsNull(Me!link) Or Me!link = "" Then
    ' Requer referencia a Microsoft Office 11 Object Library
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)

    fd.Title = "selecione o ficheiro "
    fd.Filters.Add "Todos Ficheiros", "*.jpeg; *.jpg; *.png; *.gif; *.bmp; *.pdf", 1

    fd.Show

    If (fd.SelectedItems.Count > 0) Then
    Me.link = fd.SelectedItems(1)
    ' Me.Foto.Picture = fd.SelectedItems(1)
    Else
    MsgBox "Não foi escolhido nenhum ficheiro", vbInformation, ""
    End If

    Else
    OpenFile = fHandleFile(link, WIN_NORMAL)
    End If
    PROC_EXIT:
    Exit Sub

    PROC_ERR:
    DoCmd.Hourglass False
    MsgBox Err.Number & " - " & Err.Description
    Resume PROC_EXIT


    End Sub


    avatar
    JPaulo
    Moderador
    Moderador

    Respeito às Regras 100%

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

    Re: [Resolvido]Conversão de codigo para office 365

    Mensagem  JPaulo em 18/9/2018, 12:05

    Fico feliz.

    Obrigado pelo retorno o forum agradece.

    Quando puder e se puder, ajude o fórum nos links abaixo.


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

    Pay-Pal R$ Aqui
    Pay-Pal € Aqui

    Ou ainda: Aqui (Novo)

    Sucesso e Bons Estudos
    Success and Good Studies

    Utilize o Sistema de Busca do Fórum...
    102 Códigos VBA Gratuitos...
    Instruções SQL como utilizar...

      Data/hora atual: 18/1/2019, 00:02