Copying Attachments From 1 Table To Another Using GetChunk Method - HELP

tachyon1

New member
Local time
Today, 21:25
Joined
Oct 31, 2015
Messages
4
I've been trying to this subroutine to work... with no avail.

Code:
Public Sub TransferAttachments()

Dim DB As Database
Dim rstSource As DAO.Recordset2
Dim rstDestination As DAO.Recordset2
Const ChunkSize = 32768
Dim Offset As Long
Dim TotalSize As Long
Dim Chunk As Variant
Dim Parameter As Variant
Offset = 0
Chunk = ""
Parameter = ""


Set DB = CurrentDb
Set rstSource = DB.OpenRecordset("Source Table", dbOpenDynaset)
Set rstDestination = DB.OpenRecordset("Secondary Table", dbOpenDynaset)

rstSource.MoveFirst
    Do Until rstSource.EOF
        If rstSource![ID] = 13046 Then
            TotalSize = rstSource![Attachments]![FileData].FieldSize
                Do While Offset < TotalSize
                    Chunk = rstSource![Attachments]![FileData].GetChunk(Offset, ChunkSize)
                    rstDestination.MoveFirst
                        Do Until rstDestination.EOF
                        If rstDestination![ID] = 13046 Then
                            rstDestination.Edit
                            rstDestination![Pictures]![FileData].AppendChunk Chunk
                            rstDestination.Update
                        End If
                    rstDestination.MoveNext
                    Loop
                Offset = Offset + ChunkSize
                Loop
        End If
        rstSource.MoveNext
    Loop
End Sub

It says that
Rune-time error '3020': Update or CancelUpdate without AddNew or Edit'
on the line that says:
Code:
rstDestination![Pictures]![FileData].AppendChunk Chunk

This is puzzling as the immediate line beforehand is the edit command that it wants????

A few things to note...

In the end, when this is working, I hope to adapt this so that the source table is a SharePoint linked table/list. (If anyone has any better solutions to achieve this goal, It would be appreciated).

The variable of 13046 is just used for testing and developing purposes in order to get this to work. Later on, i'll just declare this as a variable.

The attachments are just jpeg files so the entire field for each record is about 10MB.
 
If rstDestination is a recordset, and rstDestination![Pictures]![FileData] is a field in a recordset, what type of thing is rstDestination![Pictures]?

What if that was a field that contained another recordset? Maybe by assigning a value to FileData, you are editing a different recordset than you think.
 
Code:
Public Sub CopyAttachment(ByVal strTableSource As String, _
                            ByVal strSourceAttachmentField As String, _
                            ByVal strTableTarget As String, _
                            ByVal strTargetAttachmentField As String, _
                            Optional ByVal strCondition As String = "")
    Dim rstFrom As DAO.Recordset2
    Dim rstTo As DAO.Recordset2
    Dim rstMVF As DAO.Recordset2
    Dim rstMVT As DAO.Recordset2
    Dim strSQL As String
    Dim db As DAO.Database
    
    strSQL = "SELECT * FROM " & strTableSource
    Set db = CurrentDb
    If strCondition <> "" Then
        strSQL = strSQL & " WHERE " & strCondition
    End If
    Set rstFrom = db.OpenRecordset(strSQL, dbOpenDynaset)
    Set rstTo = db.OpenRecordset(strTableTarget, dbOpenDynaset)
    
    Do While rstFrom.EOF = False
        rstTo.AddNew
        'rstTo!Description = rstFrom![Description]
        Set rstMVF = rstFrom(strSourceAttachmentField).Value
        Set rstMVT = rstTo(strTargetAttachmentField).Value
        ' Copy all the attachment in the field (attachment datatype)
        Do While rstMVF.EOF = False
            rstMVT.AddNew
            rstMVT!FileData = rstMVF!FileData
            rstMVT!FileName = rstMVF!FileName
            '*********************************
            ' below fields are not updateable
            '
            'rstMVT!FileFlags = rstMVF!FileFlags
            'rstMVT!FileTimeStamp = rstMVF!FileTimeStamp
            'rstMVT!FileType = rstMVF!FileType
            'rstMVT!FileURL = rstMVF!FileURL
            '
            '*********************************
            rstMVT.Update
            rstMVF.MoveNext
        Loop
        rstMVF.Close
        rstMVT.Close
        Set rstMVF = Nothing
        Set rstMVT = Nothing
        rstTo.Update
        rstFrom.MoveNext
    Loop
    rstFrom.Close
    rstTo.Close
    Set rstFrom = Nothing
    Set rstTo = Nothing
    Set db = Nothing
End Sub
 

Users who are viewing this thread

Back
Top Bottom