Juli 14, 2020, 21:52:00

Neuigkeiten:

Wenn ihr euch für eine gute Antwort bedanken möchtet, im entsprechenden Posting einfach den Knopf "sag Danke" drücken!


Dateien (Anlage-Typ) exportieren und anders importieren

Begonnen von mad, Juni 11, 2020, 18:08:49

⏪ vorheriges - nächstes ⏩

DF6GL

Juni 14, 2020, 17:50:00 #15 Letzte Bearbeitung: Juni 14, 2020, 18:06:14 von 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!)


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)


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:
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
Zitatbis 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
--
Beaker s.a., der lieber an seinem eigenen Projekt arbeiten würde/sollte, aber irgendwie immer gerne seinen Senf dazu gibt ;-)
S.M.I².L.E.