[Resolvido]Erro ao anexar fotos 64bit

Boa noite amigos, estou com problemas para anexar fotos no formulário do access 64bit, alguém já conseguiu deixar o código do modulo localizar funcional para o access 64bit? Conforme algumas pesquisas ja fiz alterações no codigo troquei o Long por LongPtr no Declare inseri o PtrSafe para o 64bit mas não resolveu, no access 2010 32bit funciona perfeitamente, ja no access 2013 64bit não chega a abrir a caixa para pesquisar a foto.

Uso o codigo abaixo e nomeio o mesmo como localizar em um modulo:

Código:

Option Compare Database

Public Type OPENFILENAME
lStructSize As LongPtr
hwndOwner As LongPtr
hInstance As LongPtr
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustomFilter As LongPtr
nFilterIndex As LongPtr
lpstrFile As String
nMaxFile As LongPtr
lpstrFileTitle As String
nMaxFileTitle As LongPtr
lpstrInitialDir As String
lpstrTitle As String
flags As LongPtr
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As LongPtr
lpfnHook As LongPtr
lpTemplateName As String
End Type

Public Const OFN_FILEMUSTEXIST = &H1000
Public Const OFN_HIDEREADONLY = &H4
Public Const OFN_PATHMUSTEXIST = &H800
Const cTAMANHO = 11
Public Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" _
   Alias "GetOpenFileNameA" (lpofn As OPENFILENAME) As LongPtr
Public Declare PtrSafe Function GetPrivateProfileString Lib "kernel32" Alias _
   "GetPrivateProfileStringA" (ByVal lpApplicationName As String, _
   ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, _
   ByVal nSize As LongPtr, ByVal lpFileName As String) As LongPtr
Public Declare PtrSafe Function WritePrivateProfileString Lib "kernel32" Alias _
   "WritePrivateProfileStringA" (ByVal lpApplicationName As String, _
   ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As LongPtr
Public Declare PtrSafe Function FindWindow Lib "user32" Alias _
   "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As LongPtr) As LongPtr
Public Declare PtrSafe Function SendMessage Lib "user32" Alias _
   "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As LongPtr, _
   ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
   

Public Function Buscar(lngHwnd As LongPtr, strTítulo As String, strPastaInicial As String, strFiltro As String) As String
   
   Dim filebox As OPENFILENAME
   Dim result As LongPtr
   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

Para o boato de upload da foto uso o codigo abaixo:

Código:

Private Sub Foto_Click()
   Dim strCaminho As String, strPastaInicial As String
   strPastaInicial = "C:\Meus Documentos"
   strCaminho = Buscar(Me.hwnd, "Inserir foto", strPastaInicial, _
   "Arquivos gráficos (*.bmp; *.gif; *.jpg)" & vbNullChar & "*.bmp; *.gif; *.jpg")
   If Len(strCaminho) > 0 Then
       Me.LocalFoto = strCaminho
       Me.Foto.Picture = Me.LocalFoto
   End If

End Sub

Estou anexando o BD para algum amigo me ajudar a verificar isso, pois conforme falei no 32bi funciona ja no access 2013 64bit não acontece nada quando clico no quadrado de inserção de fotos.

Agradeço muito a ajuda de vocês.

Olá Paulo,

Para o que pretende, deve ajustar o código para funcionar também em 64bit.
Tema diversas vezes abordado e com exemplos, veja:
https://www.maximoaccess.com/t20840-resolvidoalterar-modulo-para-rodar-em-32-e-64-bits

No entanto se não se quiser aventurar para já na alteração do código , pode usar o filedialog para o que pretende, veja:
https://www.maximoaccess.com/t9595-resolvidoabrir-uma-pasta-diretorio-escolher-arquivo-a-carregar-para-importacao
https://www.maximoaccess.com/t8306-resolvidouso-do-application-filedialog-para-selecao-de-arquivos

Abraço

Teixeira obrigado pela resposta, mas ja pesquisei no forum e na internet fiz as mudanças e nao consegui resolver o problema, eu tenho pouco conhecimento nos codigos VBA eu precisava que alguem me ajuda-se neste meu codigo postado acima deixei até um exemplo do BD em anexo, tenho certeza que para o feras do access aqui do blog deve ser muito facil fazer isso, mas eu até o momento não consegui.

Olá Paulo,

Não é Fera, mas aqui no MaximoAccess vai ser!

Adaptei atraves de outro exemplo do fórum:
https://www.maximoaccess.com/t23187-fotos-em-fomulario-continuo-access-2003

Veja como ficou o código:

Código:

Private Sub Foto_Click()
On Error GoTo PROC_ERR

    ' Requer referencia a Microsoft Office 11 Object Library
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    
    fd.Title = "selecione o ficheiro da imagem"
    fd.Filters.Add "Arquivos de imagem", "*.bmp; *.gif; *.jpg", 1

    fd.Show
    
    If (fd.SelectedItems.Count > 0) Then
        Me.LocalFoto = fd.SelectedItems(1)
        Me.Foto.Picture = fd.SelectedItems(1)
    Else
        MsgBox "Não foi escolhido nenhum ficheiro", vbInformation, ""
    End If
    
    
PROC_EXIT:
    Exit Sub
    
PROC_ERR:
    DoCmd.Hourglass False
        MsgBox Err.Number & " - " & Err.Description
    Resume PROC_EXIT
    
End Sub

Não esquecer da referencia (duvidas ver link da minha ultima mensagem)

Segue meu exemplo:
cld.pt/dl/download/fc9bf8e0-9220-4e8b-bc62-0580963367ff/EscolherImagem.zip

Abraço

Nossa Teixeira, ficou o máximo mesmo, poxa que legal Deus te abençoe amigo, e o mais legal que neste código seu para inserir no botão de carregar, podemos deixar de lado o modulo_Localizar que estava me deixando quase louco.

Obrigado mesmo amigo me salvou.

Olá Paulo, obrigado pelo retorno.
Fico feliz por ter ajudado.

Não se esqueça de dar o tópico como Resolvido, veja como fazer:
https://www.maximoaccess.com/t860-resolucao-de-topicos

Abraço

Muito grato.