Erro em Tempo de Execução 53

Pessoal boa tarde.

Podem dar uma avaliada por gentilez se o codigo abaixo está errado.

Num Computador rodar normal, quando tento colocar em outro dar ``Erro de tempo de execução 53´´


Sd

Ênio



Sub fncLoadImage(imageId As String, ByRef Image)
Dim strCaminho As String
'Verifica se o formulário fmImagensRibbons está aberto
If Not CurrentProject.AllForms("frmImgRibbons").IsLoaded Then
'Abre formulário para somente leitura e oculto
DoCmd.OpenForm "frmImgRibbons", acNormal, , , acFormReadOnly, acHidden
'Passa para variável attanexo o campo imagens do formulário
Set attAnexo = Forms("frmImgRibbons").Controls("Imagens")
End If

'Verifica se a imagem tem extensão PNG ou ICO para aplicar a função de transformação LoadImage
If InStr(imageId, ".png") > 0 Or InStr(imageId, ".ico") > 0 Then
'Informa local e nome da imagem PNG ou ICO, extraída da tabela tblImagensRibbons
strCaminho = fncExtrairImagem(imageId)
'Transforma imagem PNG ou ICO em BMP e passa para a ribbon
Set Image = LoadImage(strCaminho)
'Deleta arquivo PNG ou ICO da pasta temporária Temp
Kill strCaminho
Else
'Carrega imagens JPG, BMP ou GIF
Set Image = attAnexo.PictureDisp(imageId)
End If
End Sub

Public Function fncExtrairImagem(strNomeImagem As String) As String

On Error GoTo Trato

Dim strCaminho As String
Dim rsPai As DAO.Recordset
Dim rsFilho As DAO.Recordset2
Dim fld As Field2
Dim fld2 As Field2

strCaminho = CurrentProject.Path & "\Temp"

Set rsPai = CurrentDb.OpenRecordset("tblImagensRibbons")
Set rsFilho = rsPai.Fields("imagemRibbon").Value
Set fld = rsFilho.Fields("filedata")
Set fld2 = rsFilho.Fields("Filename")

If Len(Dir(strCaminho, vbDirectory + vbHidden) & "") = 0 Then
FileSystem.MkDir (strCaminho)
FileSystem.SetAttr strCaminho, vbHidden
End If

Do While Not rsFilho.EOF
If fld2.Value = strNomeImagem Then
fld.SaveToFile (strCaminho)
Exit Do
End If
rsFilho.MoveNext
Loop
Set fld2 = Nothing
Set fld = Nothing
Set rsFilho = Nothing
Set rsPai = Nothing

fncExtrairImagem = strCaminho & "\" & strNomeImagem

Exit Function
Trato: Call ExplicaErro

End Function

Public Function fncMinimizaRibbon() As Boolean
Dim ws As Object
Set ws = CreateObject("WScript.shell")
If Application.CommandBars("ribbon").height > 130 Then
ws.SendKeys "^{f1}"
End If
Set ws = Nothing
End Function

Boa Noite, Avelino: perdoe pela a falta de conhecimento.


Vamos ambos notebooks estão com as mesmas plataformas Windows 10 64 bits e Office 32 bits:

Respostas:

Alguma linha fica marcado de amarelo ? Se sim, qual ?: Kill strCaminho

As versões de Access são diferentes entre os computadores ? Qual é a versão do Access no computador com o erro ? De 32 ou 64 bits ?:

Vamos ambos notebooks estão com as mesmas plataformas Windows 10 64 bits e Office 32 bit

No computador com erro - carregue o projeto no modo estrutura > abra o VBA > No menu DEPURAR, clique em COMPILAR. Nos informe se acusa algum erro nas linhas de código e qual o erro.

Estou Usando um acesso remoto não está dando para capturar as telas do erro do VBA.

Mas segue aqui o link do banco(login: senha: 123) https://mega.nz/folder/gV1BVThK#WNJAal3MFq6Ge0-SZBZn8w