Search code examples
ms-accessvbasharepoint-2007daoattachment-field

Having issues migrating data with attachments in Access


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.


Solution

  • 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).