Having issues migrating data with attachments in Access

Question

All,

I have an MS Access database that has some file attachments that I need to programmatically copy to another MS Access table (both tables are linked tables to a SharePoint 2007 list). I have the following code.

Private Sub AddAttachments(rsSource As Recordset, rsDest As Recordset)
    Dim rs2Source As Recordset2
    Dim rs2Dest As Recordset2
    Set rs2Source = rsSource.Fields!Attachments.Value
    Set rs2Dest = rsDest.Fields("Attachments").Value
    rs2Source.MoveFirst
    If Not (rs2Source.BOF And rs2Source.EOF) Then
        While Not rs2Source.EOF
            rs2Dest.AddNew
            rs2Dest!FileData = rs2Source!FileData
            rs2Dest.Update
            rs2Source.MoveNext
        Wend
    End If
    Set rs2Source = Nothing
    Set rs2Dest = Nothing
End Sub

My issue is that when it gets to rs2Dest!FileData = rs2Source!FileData, it keeps giving me an Invalid Argument error. So, if what I am trying to do is possible, how can I adjust my code to read the attachment data from one list and import it into the other list (both linked as linked-tables in an instance of MS Access).

Thanks in advance.

William · Accepted Answer · 2015-02-02T22:08:12.413

All,

Here is the clunky solution I came up with in case it helps someone else.

First, I needed to access the URLmon library's URLDownloadToFileA function.

Private Declare Function URLDownloadToFileA Lib "urlmon" (ByVal pCaller As Long, ByVal szURL As String, ByVal szfilename As String, ByVal dwreserved As Long, ByVal ipfnCB As Long) As Long

Then, I would use this library to download the file to my disk, upload from my disk, and delete the temporarily stored file as follows:

Private Function DownloadFile(URL As String, LocalFilename As String) As Boolean
    DownloadFile = (URLDownloadToFileA(0, URL, LocalFilename, 0, 0) = 0)
End Function

Private Function GetRight(strText As String, FindText As String) As String
    Dim i As Long
    For i = Len(strText) - Len(FindText) + 1 To 1 Step -1
        If Mid(strText, i, Len(FindText)) = FindText Then
            GetRight = Mid(strText, i + 1, Len(strText))
            Exit For
        End If
    Next i
End Function

Private Sub AddAttachments(rsSource As Recordset, rsDest As Recordset)
    Dim rs2Source As Recordset2
    Dim rs2Dest As Recordset2
    Set rs2Source = rsSource.Fields!Attachments.Value
    Set rs2Dest = rsDest.Fields("Attachments").Value
    Dim strDownload As String
    Dim strTemp As String
    strTemp = Environ$("TEMP")
    If Not (rs2Source.BOF And rs2Source.EOF) Then
        rs2Source.MoveFirst
        If Not (rs2Source.BOF And rs2Source.EOF) Then
            While Not rs2Source.EOF
                rs2Dest.AddNew
                'rs2Dest.Update
                'rs2Dest.MoveLast
                'rs2Dest.Edit
                strDownload = strTemp & "\" & GetRight(rs2Source!FileURL, "/")
                Debug.Print DownloadFile(rs2Source!FileURL, strDownload)
                rs2Dest.Fields("FileData").LoadFromFile strDownload
                rs2Dest.Update
                rs2Source.MoveNext
                Kill strDownload 'delete the temporarily stored file
            Wend
        End If
    End If
    Set rs2Source = Nothing
    Set rs2Dest = Nothing
End Sub

I'm sure there's an easier way, but this seem to work for my purposes (albeit in a clunky fashion that is only fitting for the likes of VBA).

Having issues migrating data with attachments in Access

1 Answers1