[resolvido] Erro ao anexar fotos no formulário - Access 2013 64bit

Moderador: Avelino Sampaio

paulopartica
Mensagens: 2
Registrado em: 17 Abr 2018, 17:51

[resolvido] Erro ao anexar fotos no formulário - Access 2013 64bit

Mensagempor paulopartica » 18 Abr 2018, 11:33

Bom dia amigos! Estou com problemas para anexar fotos no formulário do Access 64bit, alguém já conseguiu deixar o código do modulo localizar abaixo postado funcional para o Access 64bit? Conforme algumas pesquisas ja fiz alterações no código troquei o Long por LongPtr no Declare inseri o PtrSafe para o 64bit fiz a referencia no VBA 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. Fiz varias pesquisas na internet e não consegui a solução, gostaria que algum fera do Access me ajudasse neste mesmo código para anexar fotos no 64bit pois ele esta a funcionar perfeitamente no 32bit, deixo em anexo um exemplo do BD onde no proprio campo foto é clicado para fazer o upluad da foto e salvar o arquivo.


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

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 clicar na caixa de upload da foto uso este código abaixo:

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.
Você deve estar registrado e autenticado para ter acesso ao arquivo anexo.

Disable adblock

Precisamos do seu apoio. Faca uma doacao para o site atraves do Paypal.


Avatar do usuário
Avelino Sampaio
Mensagens: 1882
Registrado em: 04 Jun 2015, 18:27
Contato:

Re: Erro ao anexar fotos no formulário - Access 2013 64bit

Mensagempor Avelino Sampaio » 18 Abr 2018, 14:06

Paulo

utilize esta função abaixo que é mais atual e serve bem no 64 bits:

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


Nota: Tem que habilitar a referência MICROSOFT OFFICE 15.0 OBJECT LIBRARY

Uma alternativa é usar a coleção WizHook. Veja neste meu artigo a função OpenPictureFile()

http://www.usandoaccess.com.br/dicas/colecao-wizhook.asp?id=1&idlista=268

Aguardamos
==================================================
Clique no link abaixo e veja um ótimo kit de ensino que tenho para você.
http://www.usandoaccess.com.br
==================================================

paulopartica
Mensagens: 2
Registrado em: 17 Abr 2018, 17:51

Re: Erro ao anexar fotos no formulário - Access 2013 64bit

Mensagempor paulopartica » 19 Abr 2018, 20:03

Avelino boa tarde obrigado pela dica, mas consegui resolver com o código abaixo que foi partilhado por um caro colega do fórum maximoaccess. O interessante deste código é que não precisa de modulo, é somente inserir no botão do picture e pronto, a foto anexa.



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



No seu código como eu teria que fazer? Crio primeiro o modulo com este código e depois insiro o meu atual código no picture para anexar a imagem?

Disable adblock

Precisamos do seu apoio. Faca uma doacao para o site atraves do Paypal.



Voltar para “Formulários”

Quem está online

Usuários neste fórum: Google [Bot] e 3 visitantes