[Resolvido]Código não funciona Runtime 2013 64 Bits, nem no Microsoft Office 2013 64

Bom dia

Onde está o erro neste código para não funcionar no RunTime do Office 2013 64

Private Sub btProcurar_Click()
 
Dim strCaminho As String, strPastaInicial As String
   strPastaInicial = BackEndPath & "Tabelas"
   strCaminho = Buscar(Me.hWnd, "Inserir Caminho", strPastaInicial, _
   "Arquivos (*.accdb; *.accde; *.accdr)" & vbNullChar & "*.accdb; *.accde; *.accdr")
NovoCaminho = strCaminho
If NovoCaminho = CaminhoAtual Or NovoCaminho = "" Then
   Me!Path_0 = CaminhoAtual
Else
   Me!Path_0 = NovoCaminho
End If
Me!btSalvar.SetFocus
End Sub

Parte a vermelho vem do módulo

Public Function BackEndPath() As String
  'uso: BackEndPaht & pastadesejada
  Dim strFullPath As String
   strFullPath = DLookup("Path_0", "tblCaminhoBE")
  For I = Len(strFullPath) To 1 Step -1
      If Mid(strFullPath, I, 1) = "\" Then
          getdbpath = Left(strFullPath, I)
          Exit For
      End If
  Next
  BackEndPath = getdbpath
  End Function

Assis, me desculpe pela minha ignorancia, no comando do botao possui

strPastaInicial = BackEndPath & "Tabelas" ' Se BackEndPath é Function, o porque do restante, se na function está determinado que deverá procurar no campo Path 0 da tabela tblCaminhoBE?

outra coisa a expressao "AS STRING" não deveria estar entre os parenteses (AS STRING)


Mais uma vez peço perdao pela minha ignorancia, estou ainda no aprendizado.

Tauron
Não é só no RunTime, também acontece no Office 2013 - 64.

Mas não dá erro nem ao Compilar com Debug.

Obrigado

Tenho notado que no fórum há muitos relatos de que em access 64 bits a função de localizar arquivo não funciona.

Assis, poderia anexar um pequeno exemplo para eu testar no meu office 64 bits?

Boa noite Damasceno

Também não funciona no Microsoft Office 2013 64, pois já testei. Não dá erro nenhum.

E como consigo converter para ACCDE é porque a compilação não tem erros, certo ?

Este código abaixo funciona perfeito na versão 32, utilizo para inserir fotos que estão numa pasta no servidor numa pasta "IMAGENS" junto do Back-End.

Ao dar um click no abre diretamente a pasta das imagens.


Private Sub btnLocalizar_Click()

Dim strCaminho As String, strPastaInicial As String
strPastaInicial = BackEndPath & "IMAGENS"
strCaminho = Buscar(Me.hwnd, "Inserir Foto", strPastaInicial, _
"Arquivos gráficos (*.bmp; *.gif; *.jpg; *.Png)" & vbNullChar & "*.bmp; *.gif; *.jpg; *.Png")
If Len(strCaminho) > 0 Then
Me.LocalFoto = Mid([strCaminho], InStrRev([strCaminho], "\") + 1)
Me.FOTO.Picture = Me.LocalFoto
DoCmd.RunCommand acCmdSaveRecord
End If

End Sub

Você colocou o código do botão btnLocalizar. Eu quero o código por trás da função Buscar.

Vejo também que você é participante de um dos tópicos que acusam o problema.
https://www.maximoaccess.com/t37220-adaptar-foto-em-formulario-para-windows10

Você testou a dica que deixei no tópico?

Bom dia Damasceno

Sim é esse Buscar, que não dá erro no 64 Bits mas no 32 funciona perfeito.

Estou a alterar para a função que tem no Maestro do Mestre Avelino Sampaio:

Obrigado

Public Function fncLocalizarArquivo()
Dim fd As Office.FileDialog
On Error GoTo trataerro
Set fd = Application.FileDialog(msoFileDialogOpen)
With fd
With .Filters
.Clear
.Add "Banco de Dados", "*.accdb", 1
.Add "Todos", "*.*", 2
End With
.Title = "Selecionar Banco de Dados)"
.AllowMultiSelect = False
.InitialFileName = "c:\"
.InitialView = msoFileDialogViewPreview
If .Show Then
fncLocalizarArquivo = .SelectedItems(1)
End If
End With
sair:
Exit Function
trataerro:
fncLocalizarArquivo = ""
Resume sair:
End Function

Obrigado Damasceno

Pela mensagem Nº 6

Damasceno

O código da função Buscar, ´pode ser alterado para 32 e para 64 Bits ?

Tenho uma Base de Dados onde é utilizado muitas vezes.

Obrigado


Public Function Buscar(lngHwnd As Long, strTítulo As String, strPastaInicial As String, strFiltro As String) As String
   
   Dim filebox As OPENFILENAME
   Dim result As Long
   With filebox
       .lStructSize = Len(filebox)
       .hwndOwner = lngHwnd
       .hInstance = 0
       .lpstrFilter = strFiltro & vbNullChar & _
           "Todos os Arquivos (*.*)" & vbNullChar & "*.*" & vbNullChar & vbNullChar
       .nMaxCustomFilter = 0
       .nFilterIndex = 1
       .lpstrFile = Space(256) & vbNullChar
       .nMaxFile = Len(.lpstrFile)
       .lpstrFileTitle = Space(256) & vbNullChar
       .nMaxFileTitle = Len(.lpstrFileTitle)
       .lpstrInitialDir = strPastaInicial & vbNullChar
       .lpstrTitle = strTítulo & vbNullChar
       .flags = OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY
       .nFileOffset = 0
       .nFileExtension = 0
       .lCustData = 0
       .lpfnHook = 0
   End With

   result = GetOpenFileName(filebox)
   If result <> 0 Then
       Buscar = Left(filebox.lpstrFile, InStr(filebox.lpstrFile, vbNullChar) - 1)
   Else
       Buscar = ""
   End If

End Function

Assis, muitos esquecem, mas nas versões 64 bits, além do PtrSafe, também é preciso estar atento ao tipo Long que pode virar LongPtr. Tente adaptar a API com o código abaixo a sua função.

Type OPENFILENAME
lStructSize As Long
hwndOwner As LongPtr
hInstance As LongPtr
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 LongPtr
lpfnHook As LongPtr
lpTemplateName As String
'#if (_WIN32_WINNT >= 0x0500)
pvReserved As LongPtr
dwReserved As Long
FlagsEx As Long
'#endif // (_WIN32_WINNT >= 0x0500)
End Type

Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

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

Fonte:
usandoaccess.com.br/tutoriais/configurar-api-access-de-64-e-32-bits-ptrsafe.asp?id=1

Damasceno
Depois do código da mensagem 10 ao compilar da erro.

A sétima linha do código que passei está assim

Código:

...
nMaxCustFilter As Long
...

troque por

Código:

...
nMaxCustomFilter As Long
...

Obrigado Damasceno