[Resolvido]Adaptar Foto em Formulário para Windows10

Boa noite, amigos do Forum.

Estou tentando colocar o Aplicativo de Fotos em Formulario no meu novo Notebook. Ele funciona direitinho no antigo, com Windows 8.1 e Office 2013.
No novo notebook, com Windows 10 e Office 2013 ele não funciona. Ao clicar no botão "Buscar Foto" não acontece nada. nenhuma menagem de erro, mas não abre nenhuma pasta. Alguem poderia tentar achar o erro, por favor? Abaixo estou anexando o arquivo.
Muito obrigado.

Walter Bom dia

No meu Win 10 64 Bt e Office 2013 32 Bt, funciona direitinho.

Tem todas as actualizações do Office 2013 ?

Boas....só um pitaco.

Walter, precisa ver qual a versão do teu Office no notebook antigo.

Provavelmente, você deve estar usando uma versão 64bits no teu novo notebook e do teu antigo, deve ser 32bits.

Além do mais, veja as dicas do Assis.

Adendo: aqui no meu..Win10 Pro 64bits, Ms Office 2010 SP1- 32bits...tudo funcionando perfeitamente.

Bom dia, Silvio.
Onde eu vejo a versão? Se é 64 ou 32?

Um abraço.

Abra qualquer arquivo do Word ou Excel ou Access.

Vá no menu superior, localizar..."Arquivo". Clicar.
Depois em ajuda.
Irá aparecer na tela logo abaixo de:" Sobre o Microsoft Access ".

Isso mesmo, Silvio.
O antigo é 32 e o novo é 64 bits.
Tem como resolver isso?

Bom, tem até tem.

O caminho mais fácil e simples...tira esse de 64bits e instala um de 32bits com o Service pack atualizado.

Eu, particularmente, não entendo o porque de colocar um Office de 64bits, mundialmente é pouco usado.

Hum!
Se tiver um jeito de adaptar os códigos, talvez fosse melhor. Estou com medo de trocar o Office para 32 bits e não ser esse o problema.... Sei que nas instruções que têm "Declare" devo mudar para "Declare PtrSafe", mas acho que isso não é suficiente nesse caso. Tem outras modificações necessárias.
Vou colocar os códigos abaixo e ver se alguém pode adapta-lo para mim:

No Formulário tem esses:

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

Private Sub BuscaFoto_Click()
Dim s As String
s = OpenCommDlg()
If s <> "" Then
foto = s
foto_AfterUpdate
End If
End Sub

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

Private Sub Comando17_Click()
DoCmd.OpenForm "Fml_Tutorial"
End Sub

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

Private Sub Form_Current()
foto_AfterUpdate
End Sub

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

Private Sub foto_AfterUpdate()
Dim s As String
s = Nz(foto.Value, "")
If s <> "" Then s = IIf(Dir(s) = "", "", s)
On Error Resume Next
Imagem3.Picture = s
If Err.Number <> 0 Then Imagem3.Picture = ""
On Error GoTo 0
End Sub

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

E o Módulo:


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
End Type
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

'
'-------------------------------------------------------
' Open Common Dialog Function
'-------------------------------------------------------
Function OpenCommDlg()
Dim message$, Filter$, FileName$, FileTitle$, DefExt$
Dim Title$, szCurDir$, APIResults&
'
Filter$ = "Imagens (GIF,PCX,BMP,JPG)" & Chr$(0) & "*.BMP;*.GIF;*.PCX;*.JPG;" & Chr$(0) & _
"Todos os ficheiros (*.*)" & Chr(0) & "*.*;" & Chr(0)
Filter$ = Filter$ & Chr$(0)
'
FileName$ = Chr$(0) & Space$(255) & Chr$(0)
FileTitle$ = Space$(255) & Chr$(0)
'* Give the dialog a caption title.
Title$ = "Selecionar imagem" & Chr$(0)
'
DefExt$ = "BMP" & Chr$(0) ' extensión por defecto
szCurDir$ = CurDir$ & Chr$(0) ' directorio por defecto, el actual
'* Set up the data structure before you call the GetOpenFileName
OPENFILENAME.lStructSize = Len(OPENFILENAME)
'If the OpenFile Dialog box is linked to a form use this line.
'It will pass the forms window handle.
OPENFILENAME.hwndOwner = Screen.ActiveForm.hwnd
'If the OpenFile Dialog box is not linked to any form use this line.
'It will pass a null pointer.
'OPENFILENAME.hwndOwner = 0&
OPENFILENAME.lpstrFilter = Filter$
OPENFILENAME.nFilterIndex = 1
OPENFILENAME.lpstrFile = FileName$
OPENFILENAME.nMaxFile = Len(FileName$)
OPENFILENAME.lpstrFileTitle = FileTitle$
OPENFILENAME.nMaxFileTitle = Len(FileTitle$)
OPENFILENAME.lpstrTitle = Title$
OPENFILENAME.flags = OFN_FILEMUSTEXIST Or OFN_READONLY Or OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST
OPENFILENAME.lpstrDefExt = DefExt$
OPENFILENAME.hInstance = 0
OPENFILENAME.lpstrCustomFilter = String(255, 0)
OPENFILENAME.nMaxCustFilter = 255
'OPENFILENAME.lpstrInitialDir = ("C:\Users\walte\Desktop\Materlândia Estratégia de Saúde da Familia\MinhasFotos")
OPENFILENAME.nFileOffset = 0
OPENFILENAME.nFileExtension = 0
OPENFILENAME.lCustData = 0
OPENFILENAME.lpfnHook = 0
OPENFILENAME.lpTemplateName = 0
If apiGetOpenFileName(OPENFILENAME) <> 0 Then
OpenCommDlg = Left$(OPENFILENAME.lpstrFile, InStr(OPENFILENAME.lpstrFile, Chr$(0)) - 1)
Else
OpenCommDlg = ""
End If
End Function



Será que é possível adaptar???

Até um tempo atrás eu também usava esta forma buscar arquivos, porém substitui por outra que julguei ser mais "limpa". Veja se ela resolve seu problema.

A referência Microsoft Office XX.0 Access database engine Object Library deve está habilitada.

No seu módulo use apenas isso

Código:

Option Compare Database
Option Explicit

Public Function fncLocalizarArquivo() As String
On Error GoTo trataerro
    
    Dim fd As Office.FileDialog
    
    Set fd = Application.FileDialog(msoFileDialogOpen)
    
    With fd
    
        With .Filters
            .Clear
           '.Add "Arquivo PDF", "*.pdf", 1
            .Add "Arquivo SUAEXTENSAO", "*.SUAEXTENSAO", 1
        End With
        
        .Title = "Selecione o arquivo"
        .AllowMultiSelect = False
        .InitialFileName = "c:\"
        .InitialView = msoFileDialogViewPreview
        
        If .Show Then fncLocalizarArquivo = .SelectedItems(1)

    End With
    
sair:
    Exit Function
    
trataerro:
    fncLocalizarArquivo = ""
    Resume sair:
    
End Function

Um exemplo propriamente para buscar arquivos de imagem, e que usa a dica acima, é mostrada no tópico abaixo.

https://www.maximoaccess.com/t37121-editando-imagens-access-com-paint#253633

Algum avanço, Walter?

Resolvido!

O fórum agradece o retorno. Sucesso.