Hi all!
I wanted to share this DAO code which works great for saving attachments that are stored within a SharePoint list, which is linked to the Access db. When I was hunting for something like this, everything I came acrosss was complicated, and usually did not work. So, after some head scratching & banging, I put this together, and IT WORKED a charm. So I thought I would share, and save someone else the frustration of finding a nice simple piece of code to do the same.
BTW: If any of you geeks can suggest ways to clean it up or make it faster I am all ears. Love learning this stuff.
Code:
Sub SaveAttachments()
' Saves attachments from linked SHAREPOINT list
' Using a simple SELECT query
Dim db As DAO.Database
Dim rsParent As DAO.Recordset2
Dim rsChild As DAO.Recordset2
Dim qdfSp As DAO.QueryDef
Dim rsSpList As DAO.Recordset2
Dim rsSpListChild As DAO.Recordset2
Dim rsSpListURL As String
Set db = CurrentDb
Set rsParent = db.OpenRecordset("tbl-dyn_Attachments") ' <<< This is the dynamic table that attachments will be saved too
Set qdfSp = db.QueryDefs("qry_Attachments") ' <<< Simple SELECT query that pulls in the data from the linked table
Set rsSpList = qdfSp.OpenRecordset()
Set rsSpListChild = rsSpList.Fields("Attachments").Value
rsSpListURL = rsSpListChild.Fields("FileURL")
On Error GoTo errSaveNew
' Move to first record in the SharePoint List Recordset
rsSpList.MoveFirst
' Loop through the list until "End of File" is reached
Do Until rsSpList.EOF
rsParent.AddNew
rsParent!AttachmentID = rsSpList!ID
' Save the attachment to the storage table
' Within SharePoint, Attachments are stored on the SQL server disk, usually in the same root
' as the website. So to get the file, you have to follow the URL to the file location.
Set rsChild = rsParent.Fields("AttachFile").Value
rsChild.AddNew
rsChild.Fields("FileData").LoadFromFile (rsSpListURL)
rsChild.Update
rsParent.Update
SaveNew:
rsSpList.MoveNext
Loop
Housekeeping:
Set rsChild = Nothing
Set rsParent = Nothing
Set rsSpList = Nothing
Set qdfSp = Nothing
Set db = Nothing
Exit Sub
errSaveNew:
' if the error number = 3022 (record is already in the index)
' then GOTO next record
If Err.Number = 3022 Then
Resume SaveNew
' for any other error type, throw a error message box
Else
MsgBox "Error: (" & Err.Number & ") " & Err.Description, vbCritical
Resume Housekeeping
End If
End Sub