Public Const BlockSize = 32768  'This size can be experimented with for performance and reliability.
'http://support.microsoft.com/kb/q185958/
'http://www.borland.pl/tech/interbase.shtml

Sub FireBlobTest1()
' bmp jpg
    On Error GoTo FireBlobTest_Error
    Dim arrBmp() As Byte
    Dim Conn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim lngSize As Long
    Dim strSql As String
    Set Conn = New ADODB.Connection
    Conn.ConnectionString = "DRIVER={Firebird/Interbase(r) Driver};" _
                            & "DBNAME=localhost:" _
                            & MojaBaza & ";" _
                            & "UID=" & MyUID _
                            & ";PWD=" & MyPWD
    Conn.CursorLocation = adUseClient
    Conn.Open
    Set rs = New ADODB.Recordset
    ' zapis z pliku na dysku
    strSql = "SELECT * FROM ""tblmoja"" WHERE 1=0"
    With rs
        .Open strSql, Conn, adOpenStatic, adLockOptimistic
        .AddNew
        .Fields("id_cos") = mojeID
        .Fields("plik_nazwa") = MyFileName
        .Update
        lngSize = fRD(MyBmp, rs, "plik_blob")
        .Fields("plik_size") = lngSize
        .Update
    End With
    rs.Close
    ' odczyt to tmp plik
    rs.Open "Select * from ""tblmoja"" WHERE ""id_cos"" =" & CStr(mojeID), Conn
    Call fncWriteBLOB(rs, "plik_blob", MyTmpFile)
    rs.Close
    
    With ThisWorkbook.Worksheets("moj_arkusz")
        .OLEObjects("MojImage").Object.Picture = LoadPicture(MyTmpFile)
    End With

FireBlobTest_Exit:
    On Error Resume Next
    Conn.Close
    Set Conn = Nothing
    Exit Sub
FireBlobTest_Error:
    MsgBox "Błąd - " & Err.Number & vbCrLf & _
           "Opis - " & Err.Description & vbCrLf & _
           "Procedura - " & "FireBlobTest", vbExclamation
    Debug.Print Err.Description
    Resume FireBlobTest_Exit
End Sub

Function fncWriteBLOB(rstTable As ADODB.Recordset, _
                      ByVal strField As String, _
                      ByVal strDestination As String)

Dim intNumBlocks As Integer
Dim intDestFile As Integer
Dim intI As Integer
Dim lngFileLength As Long
Dim lngLeftOver As Long
Dim strFileData As String

    On Error GoTo FncWriteBLOB_Error
    lngFileLength = rstTable(strField).ActualSize
    If lngFileLength = 0 Then
        fncWriteBLOB = 0
        Exit Function
    End If
    intNumBlocks = lngFileLength \ BlockSize
    lngLeftOver = lngFileLength Mod BlockSize
    intDestFile = FreeFile
    Open strDestination For Output As intDestFile
    Close intDestFile
    Open strDestination For Binary As intDestFile
    strFileData = rstTable(strField).GetChunk(lngLeftOver)
    Put intDestFile, , strFileData

    For intI = 1 To intNumBlocks
        strFileData = rstTable(strField).GetChunk((intI - 1) * _
                                                  BlockSize + lngLeftOver) & ""
        Put intDestFile, , strFileData
    Next intI

FncWriteBLOB_Exit:
    On Error Resume Next
    Close intDestFile
    fncWriteBLOB = lngFileLength
    Exit Function
FncWriteBLOB_Error:
    MsgBox "Błąd - " & Err.Number & vbCrLf & _
           "Opis - " & Err.Description & vbCrLf & _
           "Procedura - " & "FncWriteBLOB", vbExclamation
    Resume FncWriteBLOB_Exit
End Function

Function fRD(ByVal PicBmpJpg As String, _
             rs As ADODB.Recordset, _
             ByVal sFld As String) As Long
Dim lngFileLength As Long
Dim lngBlocks As Long
Dim LeftOver As Long
Dim i As Long
Dim ByteData() As Byte
Dim SourceFile As Integer
    SourceFile = FreeFile
    Open PicBmpJpg For Binary Access Read As SourceFile
    lngFileLength = LOF(SourceFile)    ' Get the length of the file.
    Debug.Print "Filelength is " & lngFileLength
    If lngFileLength = 0 Then
        Close SourceFile
        MsgBox PicBmpJpg & " empty or not found."
        Exit Function
    Else
        lngBlocks = lngFileLength / BlockSize
        LeftOver = lngFileLength Mod BlockSize
        ReDim ByteData(LeftOver)
        Get SourceFile, , ByteData()
        rs.Fields(sFld).AppendChunk ByteData()
        ReDim ByteData(BlockSize)
        For i = 1 To lngBlocks
            Get SourceFile, , ByteData()
            rs.Fields(sFld).AppendChunk ByteData()
        Next i
        rs.Update
        Close SourceFile
    End If
    fRD = lngFileLength
End Function

conn.ConnectionString = "Driver=Firebird/InterBase(r) driver;UID=SYSDBA;" & _
"PWD=masterkey;DBNAME=C:\Program Files\Firebird\Firebird_2_0\examples\empbuild\EMPLOYEE.FDB;"

Dim Sql As String
Dim conn As Connection
Dim rs As Recordset

    Set conn = New Connection
        conn.ConnectionString = "DSN=PROBA"

        conn.Open
Sql = "SELECT * FROM BLABLA"
        
        Set rs = conn.Execute(Sql)