VBA Extrair imagens OLEObject de um MDB

Bom dia a todos.
Estou com um problema muito específico e não estou conseguindo solucioná-lo.
Tenho um arquivo MDB com controle funcionários e nele existe um campo "FOTO" porém a empresa aonde trabalho não está permitindo o uso do access (depois que migramos para office 2013).
Por esse motivo hoje quero usar o Excel no VBA para abrir conexão com o MDB e extrair as fotos que estão em formato OLEObject e depois mostrar elas no vba do excel.

Código de conexão

Código:


'Criado por Alyson Ronnan Martins
'Data: 2021/11/12
'Utilizar a referência: Microsoft ActiveX Data Objects 6.1 Library
Public db As ADODB.Connection
Public rs As ADODB.Recordset

Public Sub cConnectOpen()
Set db = New ADODB.Connection


With db
    .ConnectionString = "Driver={Microsoft Access Driver (*.mdb, *.accdb)};" & _
                        "ReadOnly=1;" & _
                        "DBQ=" & ThisWorkbook.Path & "\CCF-INFO.mdb;" & _
                        "DefaultDir=" & ThisWorkbook.Path '& _
                        "Uid=Admin;Pwd=;"
    .Open
End With

'Exemplo de fazer consulta
'Set rs = db.Execute("SELECT * FROM tblLeituraPonte")
'rs.Close: Set rs = Nothing

End Sub

Public Sub cConnectClose()
On Error Resume Next
db.Close
Set db = Nothing
End Sub



Código para abrir os dados no formulário:

Código:


Public Sub cFormFuncOpen()
Set rs = New ADODB.Recordset
sq = "SELECT * FROM [Funcionários] WHERE [Desligado] = False AND [Matricula] = 22000749 ORDER BY [Matricula] ASC"
'sq = "SELECT * FROM [Funcionários] WHERE [Desligado] = False ORDER BY [Matricula] ASC"
'sq = "SELECT Matricula, Desligado, Foto FROM [Funcionários] WHERE [Desligado] = False AND [Matricula] = 22000749 ORDER BY [Matricula] ASC"

rs.Open sq, db, adOpenDynamic, adLockReadOnly

End Sub


Código mais próximo de extrair os dados:

Código:

Public Sub s()
Dim iStream As ADODB.Stream

cConnectOpen
cFormFuncOpen

Set iStream = New ADODB.Stream

Dim str As String

'OLEObject


Debug.Print str
iStream.Type = adTypeBinary
iStream.Open
iStream.Write rs("Foto").Value
iStream.SaveToFile "c:\Aincrad\Teste.bmp", adSaveCreateOverWrite



End Sub

Obs.: Pesquisei muito e até agora não consegui encontrar algo.

Tópico movido, por se tratar de Excel (manipulação do VBA no Excel) e não de Access.