[Resolvido]Botão buscar imagem do item.

Olá Pessoal...

Procurei sobre este assunto nos resolvidos, mais não encontrei.

É o seguinte... tenho um formulário de produtos e nele tenho que colocar a imagem do mesmo.

Coloquei um botão com a seguinte linhas VBA:

******************************************************

Private Sub AdicionarFoto_Click()
   Dim strCaminho As String, strPastaInicial As String
   strPastaInicial = CurrentProject.Path & "\fotos\"
   strCaminho = Buscar(Me.hwnd, "Inserir foto", strPastaInicial, _
   "Arquivos gráficos (*.bmp; *.gif; *.jpg)" & vbNullChar & "*.bmp; *.gif; *.jpg")
   If Len(strCaminho) > 0 Then
       txtLocalLogo = strCaminho
       Me.Logo.Picture = txtLocalLogo
   End If
End Sub

******************************************************

Porem, quando clico no botão ele não retorna nada. Será que está faltando algum Suplemento?

Fico no aguardo e obrigado.

Esse assunto já está tratado no fórum. Veja o link abaixo

https://www.maximoaccess.com/t37949-resolvidocodigo-nao-funciona-runtime-2013-64-bits-nem-no-microsoft-office-2013-64

Olá Damasceno.
Obrigado em responder e desculpa pela demora.

Segui o link da msm n. 2 e fiz todas as mudanças de Ptr que vc sugeriu, mais infelizmente não funcionou. Ele não abre gerenciador de arquivo para escolher a imagem.

Anexe seu projeto para análise.

abjinfo, algum avanço?

Aguardamos seu retorno...

Alexandre, algum avanço?

Ainda estamos aguardando...

Olá Damasceno...

Desculpa na demora, é que fui convivendo com o problema e agora estou com um tempo para resolver.

Bom.. vou postar o código por parte.
----------------------------------------------------------------
Botão>

Private Sub AdicionarFoto_Click()
   Dim strCaminho As String, strPastaInicial As String
   strPastaInicial = CurrentProject.Path & "\fotos\produtos\"
   strCaminho = Buscar(Me.hwnd, "Inserir foto", strPastaInicial, _
   "Arquivos gráficos (*.bmp; *.gif; *.jpg)" & vbNullChar & "*.bmp; *.gif; *.jpg")
   If Len(strCaminho) > 0 Then
       txtLocalFoto = strCaminho
       Me.Foto.Picture = txtLocalFoto
   End If
End Sub
------------------------------------------------------------------

Buscar>

Option Compare Database
Public Type OpenFilename
lStructSize As Long
hwndOwner As LongPtr
hInstance As LongPtr
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustomFilter 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
'lpTemplateName As Long
pvReserved As LongPtr
dwReserved As Long
FlagsEx As Long
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 Long
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 Long, ByVal lpFileName As String) As Long
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 Long
Public Declare PtrSafe Function FindWindow Lib "user32" Alias _
   "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As Long) As Long
Public Declare PtrSafe Function SendMessage Lib "user32" Alias _
   "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
   ByVal wParam As Long, ByVal lParam As Long) As Long

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

----------------------------------------------------------------------------------------------

Revisei todo o código, inclusive com a sua sugestão e não abre.

Versão do Access 64bits
Windows 10.

Após o tópico, já foi criado exemplo pronto nos links abaixo
https://www.maximoaccess.com/t37121-editando-imagens-access-com-paint
https://www.maximoaccess.com/t38582-buscar-diretorio-de-pasta-ou-arquivo-interativamente

Ok.. obrigado em responder rapidamente.
Vou verificar e retorno.

Você realmente é muito bom.....
Muito obrigado por compartilhar e nos ajudar, pois adaptei ao meu projeto e ficou bom.
Como de praxe, vou colocar no projeto a sua colaboração com está rotina.
Valeu DamascenoJr.

O fórum agradece o retorno. Sucesso.