Convert Access Attachment data type to file system files

Question

I have a lot of files stored as attached files in an Access db. I am going to move data to an SQL server and for that purpose I need to extract the attached files and turn them into file system files.

This snippet works fine for images and pdf files but not for Office documents like Word or Excel. I assume it has something to do with encoding, but I have no clues. Any ideas?

Dim dbs As Database
Dim rs As Recordset
Set dbs = CurrentDb
Set rs = dbs.OpenRecordset("table1")
With rs
Do While Not .EOF
    Set rsRec = rs.Fields("AttFiles").Value
    While Not rsRec.EOF
        NameOfFile = "C:\temp\" & rsFil.Fields("FileName")
        Open NameOfFile For Binary Access Write As #1
        Put #1, , rsRec.Fields("FileData").Value
        Close #1
        rsRec.MoveNext
    Wend
    .MoveNext
Loop
End With
rs.Close
dbs.Close

score 5 · Accepted Answer · answered May 18 '15 at 13:49

If the File is actually an attachment type, then you might as well use the Recordset2 of the Microsoft Access Object Library. Something like,

Public Sub exportDocument(tableName As String, fieldName As String, uniqueID As Long)
On Error GoTo Err_SaveImage
    Dim rsParent As DAO.Recordset2
    Dim rsChild As DAO.Recordset2
    Dim saveAsName As String

    Set rsParent = CurrentDb.OpenRecordset("SELECT " & tableName & ".* " & _
                                           "FROM " & tableName & " WHERE " & tableName & "." & fieldName & " = " & uniqueID)
    Set rsChild = rsParent.Fields("fileData").Value

    If rsChild.RecordCount <> 0 Then
        If Dir(Environ("userprofile") & "\My Documents\tmp\", vbDirectory) <> "." Then MkDir Environ("userprofile") & "\My Documents\tmp\"

        saveAsName = Environ("userprofile") & "\My Documents\tmp\" & rsChild.Fields("FileName")

        rsChild.Fields("fileData").SaveToFile saveAsName

        FollowHyperlink saveAsName
    End If
Exit_SaveImage:
    Set rsChild = Nothing
    Set rsParent = Nothing
    Exit Sub

Err_SaveImage:
    If Err = 3839 Then
        Resume Next
    Else
        MsgBox "Some Other Error occured!" & vbCrLf & vbCrLf & Err.Number & " - " & Err.Description, vbCritical
        Resume Exit_SaveImage
    End If
End Sub

The above code will save the files to a location specified in saveAsName. I have specific unique ID in the WHERE condition. If you want to export all documents, you can alter the code accordingly, but might have to loop through the recordset. I hope this helps !

Thanx, you are right. SaveToFile crops the crap in the beginning of the attached file. Crap that pdf-readers ignore but Office don't. See also: http://stackoverflow.com/questions/25864092/ — PC-Gram, May 19 '15 at 06:19

Convert Access Attachment data type to file system files

1 Answers1