ADO samples MSDN

'BeginAppendChunkVB

    'To integrate this code
    'replace the data source and initial catalog values
    'in the connection string
    
Public Sub AppendChunkX()

    'recordset and connection variables
   Dim Cnxn As ADODB.Connection
   Dim strCnxn As String
   Dim rstPubInfo As ADODB.Recordset
   Dim strSQLPubInfo As String
    'record variables
   Dim strPubID As String
   Dim strPRInfo As String
   Dim lngOffset As Long
   Dim lngLogoSize As Long
   Dim varLogo As Variant
   Dim varChunk As Variant
   Dim strMsg As String
   
   Const conChunkSize =  100 

   ' Open a connection
   Set Cnxn = New ADODB.Connection
   strCnxn = "Provider=sqloledb;Data Source=MyServer;Initial Catalog=Pubs;User Id=sa;Password=; "
   Cnxn.Open strCnxn
   
   ' Open the pub_info table with a cursor that allows updates
   Set rstPubInfo = New ADODB.Recordset
   strSQLPubInfo = "pub_info"
   rstPubInfo.Open strSQLPubInfo, Cnxn, adOpenKeyset, adLockOptimistic, adCmdTable
   
   ' Prompt for a logo to copy
   strMsg = "Available logos are : " & vbCr & vbCr
   Do While Not rstPubInfo.EOF
      strMsg = strMsg & rstPubInfo!pub_id & vbCr & _
         Left(rstPubInfo!pr_info, InStr(rstPubInfo!pr_info, ",") -  1 ) & _
         vbCr & vbCr
      rstPubInfo.MoveNext
   Loop
   
   strMsg = strMsg & "Enter the ID of a logo to copy:"
   strPubID = InputBox(strMsg)
   
   ' Copy the logo to a variable in chunks
   rstPubInfo.Filter = "pub_id = '" & strPubID & "'"
   lngLogoSize = rstPubInfo!logo.ActualSize
   Do While lngOffset < lngLogoSize
      varChunk = rstPubInfo!logo.GetChunk(conChunkSize)
      varLogo = varLogo & varChunk
      lngOffset = lngOffset + conChunkSize
   Loop
   
   ' Get data from the user
   strPubID = Trim(InputBox("Enter a new pub ID" & _
                            " [must be > 9899 & < 9999]:"))
   strPRInfo = Trim(InputBox("Enter descriptive text:"))

   ' Add the new publisher to the publishers table to avoid
   ' getting an error due to foreign key constraint
   Cnxn.Execute "INSERT publishers(pub_id, pub_name) VALUES('" & _
                  strPubID & "','Your Test Publisher')"
   
   ' Add a new record, copying the logo in chunks
   rstPubInfo.AddNew
   rstPubInfo!pub_id = strPubID
   rstPubInfo!pr_info = strPRInfo

   lngOffset =  0  ' Reset offset
   Do While lngOffset < lngLogoSize
      varChunk = LeftB(RightB(varLogo, lngLogoSize - lngOffset), _
         conChunkSize)
      rstPubInfo!logo.AppendChunk varChunk
      lngOffset = lngOffset + conChunkSize
   Loop
   rstPubInfo.Update
   
    ' Show the newly added data
   MsgBox "New record: " & rstPubInfo!pub_id & vbCr & _
      "Description: " & rstPubInfo!pr_info & vbCr & _
      "Logo size: " & rstPubInfo!logo.ActualSize

   ' Delete new records because this is a demo
   rstPubInfo.Requery
   Cnxn.Execute "DELETE FROM pub_info " & _
      "WHERE pub_id = '" & strPubID & "'"

   Cnxn.Execute "DELETE FROM publishers " & _
      "WHERE pub_id = '" & strPubID & "'"

    ' clean up
   rstPubInfo.Close
   Cnxn.Close
   Set rstPubInfo = Nothing
   Set Cnxn = Nothing

End Sub
'EndAppendChunkVB

Private Sub Command1_Click()
Dim FotoData() As Byte

    ....
    If rsData("Image").ActualSize >  0  Then
        FotoData = rsData("Image").Value
        Open "c:\tmp.doc" For Binary As # 1 
        Put # 1 , , FotoData
        Close # 1 
    End If
    ....

    Shell "c:\tmp.doc"
End Sub

Shell "C:\Program Files\Microsoft Office\OFFICE11\winword.exe C:\tmp.doc", vbNormalFocus

Function BinExport(TableName As String, FileName As String, BinaryFeld As String, IDNr As String)
Dim DB As DAO.Database, rs As DAO.Recordset, I As Long, Nr As Long, BinaryData() As Byte

Set DB = CurrentDb
Set rs = DB.OpenRecordset("Select " & BinaryField & " from " & TableName & " where [ID]=" & IDNr)
rs.MoveFirst

Nr = FreeFile

  Open FileName For Binary As #Nr

    ReDim BinaryData(rs(BinaryFeld).FieldSize)

    BinaryData() = rs(BinaryFeld).GetChunk( 0 , rs(BinaryFeld).FieldSize)
    Put #Nr, , BinaryData()

  Close #Nr

  Erase BinaryData

  rs.Close
  DB.Close
  Set rs = Nothing
  Set DB = Nothing

End Function