[Resolvido]Conversão de codigo para office 365

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

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.

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...

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.

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.

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

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

É só fazer o que lhe passei acima.

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

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;
https://www.maximoaccess.com/t8306-resolvidouso-do-application-filedialog-para-selecao-de-arquivos

Olá a todos,

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

Abraço

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

Fico feliz.

Obrigado pelo retorno o forum agradece.

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