Private Sub Command1_Click()
    Dim DbFileName As String
 
    '--------- Neue Datenbank kopieren -----------------------------------
    '--------- Muster.mdb muss schon existieren --------------------------
    DbFileName = App.Path & "\Bilder" & Format(Now(), " yyyyMMddhhmmss") & _
      ".mdb"
    FileCopy App.Path & "\Muster.mdb", DbFileName
 
    '--------- Connection öffnen -----------------------------------------
    Dim xpConn  As ADODB.Connection
 
    Set xpConn = New ADODB.Connection
    xpConn.CursorLocation = adUseServer
    xpConn.Mode = adModeShareDenyNone
    xpConn.Provider = "Microsoft.Jet.OLEDB.4.0"
    xpConn.ConnectionString = "Data Source=" & DbFileName
    xpConn.Open
 
    '--------- RecordSet vorbereiten -------------------------------------
    Dim xpRs    As ADODB.Recordset
 
    Set xpRs = New ADODB.Recordset
    xpRs.CursorLocation = adUseServer
    xpRs.CursorType = adOpenForwardOnly
    xpRs.LockType = adLockOptimistic
    xpRs.ActiveConnection = xpConn
 
    xpRs.Open "SELECT * FROM Bilder"
 
    '-------- Loop: Bilder in Datenbank speichern ------------------------
    Dim BildNr          As Long
    Dim arrBin(30000)   As Byte     ' Byte-Array, in das die Bilder der
                                    ' Kamera eingelesen werden
 
    For BildNr = 1 To 1000
 
        '--------- Bild aus der Kamera lesen  -----------------------
 
        '--------- in neuem Datensatz speichern ---------------------
        xpRs.AddNew
        xpRs.Fields("Datum").Value = Now()
        xpRs.Fields("Bild").Value = arrBin()  
        xpRs.Update
 
        '------- Test-Anzeige ---------------------------------------
        Me.Cls
        Me.Print BildNr
        DoEvents
    Next
 
    '------------------ Fertig, alles schließen --------------------------
    xpRs.Close
    Set xpRs = Nothing
    xpConn.Close
    Set xpConn = Nothing
 
    MsgBox "Fertig"
 
End Sub