MS Access Export script

ms_access.txt

Option Compare Database

Public Function GetUniqueFileName(ByVal filePath As String) As String
    Dim counter As Integer
    Dim newFilePath As String

    newFilePath = filePath
    counter = 1

    Do While Len(Dir(newFilePath)) > 0
        newFilePath = Left(filePath, Len(filePath) - Len(Right(filePath, 4))) & "_" & counter & Right(filePath, 4)
        counter = counter + 1
    Loop

    GetUniqueFileName = newFilePath
End Function

Public Sub ExtractAllAttachments(ByVal TableName As String, ByVal AttachmentColumnName As String, ByVal ToDirectory As String)

    Dim rsMainRecords As DAO.Recordset2
    Dim rsAttachments As DAO.Recordset2
    
    Set rsMainRecords = CurrentDb.OpenRecordset("SELECT " & AttachmentColumnName & _
                                                " FROM " & TableName & _
                                                " WHERE " & AttachmentColumnName & ".FileName IS NOT NULL")
    
    Do Until rsMainRecords.EOF
    
        Set rsAttachments = rsMainRecords.Fields(AttachmentColumnName).Value
        
        Do Until rsAttachments.EOF
        
        outputFileName = GetUniqueFileName(ToDirectory & "\" & rsAttachments.Fields("FileName").Value)
        rsAttachments.Fields("FileData").SaveToFile outputFileName
        
            rsAttachments.MoveNext
        Loop
        
        rsMainRecords.MoveNext
    Loop
    
    rsMainRecords.Close
    
    Set rsAttachments = Nothing
    Set rsMainRecords = Nothing

End Sub