[Resolvido]Extrair imagem do DB ACCESS 2010 para uma pasta

Olá amigos especialistas em ACCESS!

Estou precisando extrair fotos do uma tabela para uma pasta. Essas fotos foram inseridas no campos ANEXO e realmente não consegui nenhuma alternativa para esse procedimento no fórum e em nenhum outro lugar.

Gostaria de extraí-las e vincular novamente para tornar o DB mais leve. Atualmente está com mais de 30 MB por conta dessas imagens.

Estou enviando o arquivo para que possam analisar e creio que terei uma resposta positiva.
(retirei a maioria dos dados para poder enviar)

Grato desde já pela atenção.

Amigo, nunca tive essa necessidade... Porem pesquisando aqui no fórum mesmo achei algo que funciona...



Crie um Modulo novo, e cole isto dentro:

Código:

Public Function SaveAttachmentsTest(strPath As String, Optional strPattern As String = "*.*") As Long
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim rsA As DAO.Recordset2
Dim rsB As String
Dim fld As DAO.Field2
Dim OrdID As DAO.Field2
Dim strFullPath As String

'Get the database, recordset, and attachment field
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("tb1")
Set fld = rst("xAnexo")
Set OrdID = rst("ID")

'Navigate through the table
Do While Not rst.EOF

'Get the recordset for the Attachments field
Set rsA = fld.Value
rsB = OrdID.Value

'Save all attachments in the field
Do While Not rsA.EOF
If rsA("FileName") Like strPattern Then
'To Export the data, use the line below
strFullPath = strPath & "\" & rsA("FileName")

'Make sure the file does not exist and save
If Dir(strFullPath) = "" Then
rsA("FileData").SaveToFile strFullPath
End If

'Increment the number of files saved
SaveAttachmentsTest = SaveAttachmentsTest + 1
End If

'Next attachment
rsA.MoveNext
Loop
rsA.Close

'Next record
rst.MoveNext
Loop

rst.Close
dbs.Close

Set fld = Nothing
Set rsA = Nothing
Set rst = Nothing
Set dbs = Nothing
End Function


Feito isso, no click de um botão chame a função dessa forma:

Call SaveAttachmentsTest("D:\1")
Veja que aqui esta a pasta de destino das fotos: D:\1 altere para sua pasta.

Veja que sera necessário alterar o Nome da Tabela, Nome do Campo que tem o Anexo e a chave primaria, nessa parte:
Set rst = dbs.OpenRecordset("tb1")
Set fld = rst("xAnexo")
Set OrdID = rst("ID")


Nesse exemplo a tabela se chama: Tb1 , o campo anexo se chama xAnexo e a chave primaria se chama ID

Fonte:
https://www.maximoaccess.com/t17933-exportar-ou-extrair-imagens-de-campo-anexo

Muito obrigado amigo.

Funcionou perfeitamente.

Grande abraço!

Grato pelo retorno.
Por favor marque o topico como Resolvido.