Dateien (Anlage-Typ) exportieren und anders importieren

[DF6GL]

Hallo,



entspr. dem Beziehungsfenster und wenn mehrere Anhänge pro Datensatz existieren (können)- Der Code exportiert alle Datei-Anhänge aus allen Datensätzen in der Tabelle "tblDokumente" in das  Verzeichnis "Export_DB", das unterhalb des DB-Verzeichnisses angelegt ist (bzw. wird):

(Luftcode, nicht getestet!)

Code [Auswählen] Erweitern

Public Sub btnExport_Click()

    Dim strPfad As String
    Dim rsDokument as Dao.Recordset
    Dim rsAnhang as Dao.Recordset2
    Const DocDir As String = "Export_DB"     'Name des Unterverzeichnisses, in das die Dateien exportiert werden sollen

On Error goto MyErr

strPfad = CurrentProject.Path & "\" & DocDir & "\"     ' Name des kompletten Pfades zum Unterverzeichnis
If Dir(strPfad, vbDirectory) = "" Then MkDir strPfad    'Erstellen des Unterverzeichnisses, falls noch nicht vorhanden
       Set db = CurrentDb       'Referenz auf aktuelle Datenbank
       Set rsDokument = db.OpenRecordset("Select DokuAnlage from tblDokumente", dbOpenSnapshot)   ' Recordset öffnen mit allen DS aus tblDokumente
            If Not (rsDokument.BOF and rsDokument.EOF)  Then   ' nur wenn DS vorhanden sind weitermachen
             
                 Do Until rsDokument.EOF   ' Alle DS durchlaufen
                     Set rsAnhang = rsDokument.Fields("DokuAnlage").Value  ' Recordset öffnen mit den Anlagen des aktuellen DS
                 
                         While Not rsAnhang.EOF      ' Solange durchlaufen, bis alle Anhänge exportiert sind
                               rsAnhang.Fields("FileData").SaveToFile     strPfad  &   rsAnhang.Fields("FileName")  'Binärdaten abspeichern in Datei im Unterverzeichnis
                        rsAnhang.MoveNext                 ' zum nächsten Anhang gehen
                        Wend                'Ende des Schleifendurchlaufs der Anhänge

                 rsDokument.Movenext            'zum nächsten Tabellen-DS gehen
                 Loop                 'Schleifenende des Tabellen-Datensatz-Durchlaufs

             End If

Exit_Sub:
   If not rsDokument is Nothing: rsDokument.close: set rsDokument = Nothing          'aufräumen
   If not rsAnhang is Nothing: rsAnhang.close: set rsAnhang = Nothing                       'aufräumen


    Exit Sub


MyErr:
  Msgbox Err.Number & ":   " & Err.Description
  Resume Exit_Sub
End Sub


Wenn nur der aktuelle DS im Formular behandelt werden soll, dann darf nur der aktuelle Dokumente-DS angesprochen werden (entspr. Codezeile ersetzen)

Code [Auswählen] Erweitern


Set rsDokument = db.OpenRecordset("Select DokuAnlage from tblDokumente Where DokuAutoNr = " & Me!DokuAutoNr , dbOpenSnapshot)   ' Recordset öffnen mit Datensatz der aktuellen ID



Vielleicht bringt das jetzt einen Schritt näher an die Lösung heran.....

[mad]

Hallo Zusammen,

bis auf das Häckchen "Variablendeklaration" waren bereits alle angehakt.
Die Hilfe habe ich mir auch durchgelesen, allerdings reicht da einmal lesen nicht bis ich das verstehe.

Aber am Ende hat es funktioniert.
mein aktueller Code,vielleicht hilfts ja jemanden:

Code [Auswählen] Erweitern

Private Sub btnExport_Click()
       Set db = CurrentDb       'Referenz auf aktuelle Datenbank
       Set rsDokument = db.OpenRecordset("Select DokuAnlage from tblDokumente", dbOpenSnapshot)   ' Recordset öffnen mit allen DS aus tblDokumente
            If Not (rsDokument.BOF And rsDokument.EOF) Then    ' nur wenn DS vorhanden sind weitermachen
             
                 Do Until rsDokument.EOF   ' Alle DS durchlaufen
                     Set rsAnhang = rsDokument.Fields("DokuAnlage").Value  ' Recordset öffnen mit den Anlagen des aktuellen DS
                 
                         While Not rsAnhang.EOF      ' Solange durchlaufen, bis alle Anhänge exportiert sind
                               'rsAnhang.Fields("FileData").SaveToFile strPfad & rsAnhang.Fields("FileName")         'Binärdaten abspeichern in Datei im Unterverzeichnis
                                rsAnhang.Fields("FileData").SaveToFile _
                                "C:\Users\mad\Documents\Feuerwehr\Datenbank\FF_DB_Tabellen\Export_DB"
                         rsAnhang.MoveNext                 ' zum nächsten Anhang gehen
                        Wend                'Ende des Schleifendurchlaufs der Anhänge
                 rsDokument.MoveNext            'zum nächsten Tabellen-DS gehen
                 Loop                 'Schleifenende des Tabellen-Datensatz-Durchlaufs
             End If
Exit_Sub:
    Exit Sub


MyErr:
  MsgBox Err.Number & ":   " & Err.Description
  Resume Exit_Sub
End Sub
Habe auch bereits alles umgesetzt, und es funktioniert bestens.

Ich möchte mich recht herzlich bei allen Unterstützern bedanken, ohne euch hätte es mal wieder nicht geklappt.


Danke, Danke, Danke
mad

[Beaker s.a.]

@mad

bis auf das Häckchen "Variablendeklaration" waren bereits alle angehakt.

Das ist allerdings das wichtigste. Dadurch wirst du gezwungen alle
Variablen vor der Verwendung mit "Dim" und dem passenden Datentyp
(String, Zahl, Objekt) zu deklarieren. Bei deinen ersten Codeversuchen
wäre dir damit auch sofort aufgefallen, dass die beiden RecordSets nicht
deklariert wurden. Ausserdem werden damit Tippfehler schon beim
Kompilieren entdeckt.
Die anderen Optionen dienen mehr oder weniger nur dem bequemeren
Coden und Debuggen, halte sie aber trotzdem für unerlässlich.
gruss ekkehard