Importar ficheiro como anexo para a tabela com VBA

Olá pessoal.

Pesquisei muito e não encontrei o que eu queria, alem disso alguns tópicos que li e que poderiam ajudar estão com os links dos exemplos quebrados.

Vamos ao que interessa!

Quero simplesmente anexar alguns arquivos em um campo do tipo anexo usando VBA.

Já li e vi a recomendação dos mestres, que não é legal anexar arquivos direto no DB para que ele não fique pesado, entendi sobre isso, mas insisto em aprender fazer isso.

Entã vamos lá...
Tenho um formulário (não está vinculado à tabela e pretendo mante-lo assim) que já me dá o caminho dos arquivos desejados, agora falta simplesmente anexar esses arquivos na minha tabela usando o VBA.

Alguém pode me ajudar.

Olá Leomar,

Veja se ajuda:
https://www.maximoaccess.com/t19844-resolvidocomo-gravar-arquivo-zip-no-bd
https://www.maximoaccess.com/t23419-resolvido-gravar-upload-arquivos-pdf-jpg-docx-xlsx-zip-em-uma-tabela-vinculada-ao-sql-server
https://www.maximoaccess.com/t32018-variavel-para-armazenar-campo-tipo-anexo

Abraço

ah teixeira

já tinha visto alguns dessas postagens antes, somente esse segundo link que foi novidade pra mim. Infelizmente não consegui compreender, acho que a conversa na postagem foi muito avançada pra mim.

Vou deixar em anexo o que já tenho desenvolvido, nele já usei algumas soluções disponibilizada pelo mestre Avelino. Não consigo gravar o arquivo selecionado no formulário como anexo na tabela .

Olá Leomar,

Ainda não tive oportunidade para exemplificar, no entanto se tiver com tempo, veja link abaixo:
sourcedaddy.com/ms-access/working-with-attachment-fields.html

Abraço

Olá Leomar,

Hoje arranjei um tempinho e fiz exemplo para mostrar o "caminho das pedras".
Está a pedir para escolher o ficheiro e adiciona à tabela, exemplo simples (apenas para um ficheiro por registo), veja o código usado:

Código:

Private Sub cmdAdicionar_Click()
'Álvaro Teixeira (ahteixeira) 2020 para MaximoAccess
'Requer fncSelecionaFicheiro() para escoher ficheiro
    On Error GoTo Err_Adicionar
    Dim sFicheiro As String

    sFicheiro = fncSelecionaFicheiro()

    If Len(sFicheiro) & "" = 0 Then Exit Sub
  
    Dim db As DAO.Database
    Dim rsParent As DAO.Recordset2
    Dim rsChild As DAO.Recordset2
    
    Set db = CurrentDb
    Set rsParent = Me.Recordset
    
    rsParent.Edit
    
    Set rsChild = rsParent.Fields("AnexoCarro").Value
    
    rsChild.AddNew
    rsChild.Fields("FileData").LoadFromFile (sFicheiro)
    
    rsChild.Update
    rsParent.Update
    
Exit_Adicionar:
    
    Set rsChild = Nothing
    Set rsParent = Nothing
    Exit Sub
    
Err_Adicionar:
    
    If Err = 3820 Then
        MsgBox "Já existe o ficheiro.", vbInformation, ""
        Resume Next
    Else
        MsgBox Err.Number & " - " & Err.Description, vbCritical, ""
        Resume Exit_Adicionar
    End If
End Sub


Function fncSelecionaFicheiro() As String
'Álvaro Teixeira (ahteixeira) 2020 para MaximoAccess
'Requer referencia a Microsoft Office xx.0 Object Library
    On Error GoTo PROC_ERR
    
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    
    fd.Title = "Selecione o ficheiro"
    fd.InitialFileName = CurrentProject.Path
    fd.Filters.Add "Todos os ficheiros", "*.*", 1

    fd.Show
    
    If (fd.SelectedItems.Count > 0) Then
        fncSelecionaFicheiro = fd.SelectedItems(1)
    Else
        MsgBox "Não foi escolhido nenhum ficheiro.", vbInformation, ""
    End If
    
PROC_EXIT:
    Exit Function
    
PROC_ERR:
    DoCmd.Hourglass False
    If Err.Number = 3011 Then
       MsgBox "Ficheiro inválido.", vbInformation, ""
    Else
        MsgBox Err.Number & "-" & Err.Description, vbCritical, ""
    End If
    Resume PROC_EXIT
End Function



Para adicionar mais que um ficheiro ver links das mensagens anteriores e ajustar.

Abraço

Olá Leomar

Como ficou a situação?
Aguardamoa o retorno.

Abraço