Add Attachment to Access DB using Excel VBA

Question

I have been researching for the past couple hours and had no luck finding a solution to this. What I want to do is have users fill a user form from Excel and submit the data to Access but one of the fields requires a screenshot which is essentially an attachment. I have been trying two sets of codes (DAO and ADODB). I am able to submit any other datatype to Access easily using the ADODB connection but not an attachment. Below are my 2 codes:

    Private Sub cmdSave_Click()

    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogOpen)
    With fd
        .AllowMultiSelect = False
        .Title = "Please select file to attach"
        If .Show = True Then
            SelectFile = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    Set fd = Nothing

Dim NewCon As DAO.Database
Dim RS As DAO.Recordset
Dim strFileName As String
Dim wrkAcc As Workspace

Set NewCon = OpenDatabase("C:\Users\my.user\Documents\Database1.accdb")
Set RS = OpenRecordset("REPORTS", dbOpenTable)

RS.Edit

RS.Fields("NAME").Value = Application.UserName
RS.Fields("DATE_REPORT").Value = Date
RS.Fields("CLAIM_TYPE").Value = "Fielda"
RS.Fields("CLIENT_NAME").Value = "Fieldb"
RS.Fields("ISSUE").Value = "Fieldc"
RS.Fields("REPORT_NUMBERS").Value = "Fieldd"
'RS.Fields("ATTACHMENTS").      (this is where I want to place the attachment)
RS.Fields("LOG_TIME").Value = Now

RS.Close
NewCon.Close

End Sub

This is the ADODB:

Private Sub Image1_Click()


    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogOpen)
    With fd
        .AllowMultiSelect = False
        .Title = "Please select file to attach"
        If .Show = True Then
            SelectFile = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    Set fd = Nothing

        Dim NewCon As ADODB.Connection
        Set NewCon = New ADODB.Connection
        Dim Recordset As ADODB.Recordset
        Set Recordset = New ADODB.Recordset

        NewCon.Open "Provider=Microsoft.ace.oledb.12.0;Data Source=C:\Users\my.user\Documents\Database1.accdb"
        Recordset.Open "REPORTS", NewCon, adOpenDynamic, adLockOptimistic
        Recordset.AddNew

        Recordset.Fields(1).Value = Application.UserName
        Recordset.Fields(2).Value = Date
        Recordset.Fields(3).Value = "Fielda"
        Recordset.Fields(4).Value = "Fieldb"
        Recordset.Fields(5).Value = "Fieldc"
        Recordset.Fields(6).Value = "Fieldd"
'       Recordset.Fields(6) (this is where I want to place the attachment)
        Recordset.Fields(8).Value = Now

        Recordset.Update
        Recordset.Close
        NewCon.Close

        End Sub

@Sorceri If you have a dupe, then mark it as such. Else, I'd say we can have it here too. The closest dupe I could find was [this one](https://stackoverflow.com/questions/18237180/add-view-attachments-using-ms-access-vba), but the relevant code is linked and the link is dead. — Erik A, Dec 19 '17 at 09:41
@ErikvonAsmuth third link down was the solution, the point is they couldn't have searched that hard if I can find it in 10 seconds. — Sorceri, Dec 19 '17 at 14:46

score 2 · Answer 1 · answered Dec 19 '17 at 09:36

DAO is the easiest way to work with attachment in my opinion.

The attachment field is actually a subtable, which can be opened as a recordset. You can work with the field like with any recordset. The "FileData" field stores a compressed version of the files in the attachment field.

You can call the LoadFromFile method to load a new file into the "FileData" field, or the SaveToFile method to save back the attachment to disk.

There are some other fields in that recordset, such as the filename, which are auto-populated when you use the LoadFromFile method

Some changes need to be made.

Value initializations need to use DAO.Recordset2 to support attachments:

Dim RS As DAO.Recordset2
Dim rsAttachments As DAO.Recordset2

Assignment section, use the inner recordset:

RS.Fields("REPORT_NUMBERS").Value = "Fieldd"
Set rsAttachments = RS.Fields("ATTACHMENTS").Value
rsAttachments.AddNew
rsAttachments.Fields("FileData").LoadFromFile SelectFile
rsAttachments.Update
rsAttachments.Close
RS.Fields("LOG_TIME").Value = Now

Add Attachment to Access DB using Excel VBA

1 Answers1