Dim ado_db As ADODB.Connection
Dim ado_rs As ADODB.Recordset
 
    Set ado_rs = New ADODB.Recordset
    ado_rs.Open sql, db_anw, adOpenDynamic, adLockOptimistic, adCmdText
 
    bol_x = objTool.StoreFile(ado_rs, str_DataFeld, str_Path)
    fnc_StoreFile_BLOB = bol_x
 
Set ado_rs = Nothing
Set ado_db = Nothing
Set objTool = Nothing

Public Function StoreFile(ado_rs As ADODB.Recordset, _
     strField As String, sFilename As String) As Boolean
On Error GoTo err_StoreFile
 
'-----------------------------------------------------------
' Stores data from given file into database
' returns true, if new record could be stored
' Übergabewerte:
' ado_rs: Recordset in dem die Daten gespeichert werden sollen
' strField: Feld in dem gespeichert werden soll
' sFileName: Datei
'-----------------------------------------------------------
 
Dim hFile As Integer
Dim i As Long
Dim nFileLength As Long
Dim nBuffers As Long
Dim nRemainder As Long
Dim vBuffer() As Byte
 
    'open recordset for write and source file for read
    hFile = FreeFile
    Open sFilename For Binary Access Read As #hFile
 
    'calculate buffers for chunk operations
    nFileLength = LOF(hFile)
    nBuffers = nFileLength \ mnBufferSize
    nRemainder = nFileLength Mod mnBufferSize
 
    'Wenn nRemainder 0 ist, dann Variable höher setzen, damit beim
    ' ReDim kein Fehler auftritt. Auswirkungen??? Derzeit unbekannt.
    If nRemainder = 0 Then nRemainder = 2
 
    With ado_rs
        'open recordset
        '.AddNew
        'fill oleobject field with chunks from file:
        'first process buffers of predefined size...
        ReDim vBuffer(mnBufferSize - 1)
        For i = 0 To nBuffers - 1
            Get #hFile, i * mnBufferSize + 1, vBuffer
            .Fields(strField).AppendChunk vBuffer
        Next
        '...then the file remainder
        ReDim vBuffer(nRemainder - 1)
        Get #hFile, i * mnBufferSize + 1, vBuffer
        Close hFile
        'fill the other record fields, too
        .Fields(strField).AppendChunk vBuffer
        'commit changes in rew record
        .update
    End With
    'refresh the entrylist recordset
    StoreFile = True
 
exit_StoreFile:
    Exit Function

Ist das Leben nicht sch?n?