Hallo Zusammen,
habe schon einiges dazu gelesen konnte aber noch nicht das richtige finden.
Derzeit sind in meiner ,,tblDokumente" alle Dokumente wie (.doc, .xls, .txt, .zip, .jpg, usw.) als Anlage-Typ in das Feld ,,DokuAnlage" eingefügt. Das bläht die DB extrem auf. Das möchte ich gerne ändern.
Dazu habe ich wie im Beitrag https://www.access-o-mania.de/forum/index.php?topic=24910.0 mein Tabellen umgestellt, siehe Beziehungsbild.
Ich würde gerne die Anhänge (Aktuell ca. 680, teils mit mehreren Dateien) per Code in ein separates Verzeichnis exportieren. Idealerweise mit dem Originaldateinamen und der Nummer aus dem Feld ,,DokuAutoNr" (=Autowert) vorangestellt (Bsp.: 1_1_Dateiname.xls, od. 205_1_Dateiname.jpg, etc., wenn es mehrere Dateien im Feld Anhang gibt, dann soll die zweite Zahl weiter gezählt werden: 205_2_... od. 205_3_... usw.).
Nun wäre es natürlich perfekt, daß ich in Verbindung mit dem im obigen Betrag erstellen Code:
Private Sub btnDatAnhang_Click()
Dim fDialog As Office.filedialog, varFile As Variant
Set fDialog = Application.filedialog(msoFileDialogFilePicker)
With fDialog
.AllowMultiSelect = False
.Title = "Please select one or more files"
.Filters.Clear
'.Filters.Add "Access Databases", "*.MDB"
'.Filters.Add "Access Projects", "*.ADP"
.Filters.Add "All Files", "*.*"
' Verzeichnis vordefiniert
'.InitialFileName = "C:\Users\......."
If .Show = True Then
'in welches Feld der Wert gespeichert wird
Me!AnhDoku_VollDateiName = .SelectedItems(1)
Else
MsgBox "You clicked Cancel in the file dialog box."
End If
End With
End Sub
die exportierten Dateien wieder in die ,,tblDokuAnhaenge" importiert werden könnten. Wobei eben dann die erste Zahl der exportierten Dateien dem Autowert ,,DokuAutoNr" aus der ,,tblDokumente" entspricht und die zweite Zahl wie viele Anhänge in der ,,tblDokuAnhaenge" für die ,,DokuAutoNr" = ,,Anh_DokuAutoNr" abgelegt sind, bzw. sein sollen.
Anschliessend würde ich das Feld ,,DokuAnlage" löschen!
Ist das so überhaupt möglich, gibt es andere Lösungswege, oder muß ich das händisch erledigen?
Über Hilfe würde ich mich wieder sehr freuen.
Gruss
mad
Nachträgliche Ergenzung: (21:05 Uhr)
Könnte für den export dieser Code event. abgeändert werden?
Public Sub AnlagePerDAO_II()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim rstZiel As DAO.Recordset
Dim rstAnlagen As DAO.Recordset2
Dim rstAnlagenZiel As DAO.Recordset2
Set db = CurrentDb
Set rst = db.OpenRecordset("SELECT * FROM tblBeispielanlagen", dbOpenDynaset)
Set rstZiel = db.OpenRecordset("SELECT * FROM tblBeispielanlagenZiel", dbOpenDynaset)
Do While Not rst.EOF
With rstZiel
.AddNew
!Beispieltext = rst!Beispieltext
Set rstAnlagen = rst.Fields("Beispielanlage").Value
Set rstAnlagenZiel = rstZiel.Fields("Beispielanlage").Value
Do While Not rstAnlagen.EOF
rstAnlagenZiel.AddNew
rstAnlagenZiel!FileData = rstAnlagen!FileData
rstAnlagenZiel!FileName = rstAnlagen!FileName
rstAnlagenZiel.Update
rstAnlagen.MoveNext
Loop
.Update
End With
rst.MoveNext
Loop
End Sub
Hallo Zusammen,
wie ich die Pfad/Dateinamen in das Textfeld und die Beziehungen in die "tblDokuAnhaenge" bringe habe ich nun über eine Abfrage gelöst.
Bräuchte nun eigentlich nur noch eine Lösung wie ich alle Dateien aus dem Anlage-Feld "DokuAnlage" in ein definiertes Verzeichnis exportieren kann.
Das mit dem Voranstellen des Autowertes und dem Zähelr hätte sich somit auch erledigt.
Gruss
mad
Hallo Zusammen,
habe mich mal weiter durchs WWW gekämpft und folgendes zu "SaveToFile" unter Microsoft gefunden.
https://docs.microsoft.com/de-de/office/client-developer/access/desktop-database-reference/field2-savetofile-method-dao
Habe das versucht auf meinen Fall anzuwenden, laufe aber bereits in der zweiten Zeile
ZitatSet rsDokument = db.OpenRecordset("DokuAutoNr")
auf den Laufzeitfehler 424.
Mein aktueller Code:
Private Sub btnExport_Click()
Set rsDokument = db.OpenRecordset("DokuAutoNr")
Set rsAnhang = rsDokument.Fields("DokuAnlage").Value
While Not rsAnhang.EOF
rsAnhang.Fields("FileData").SaveToFile _
"C:\...."
rsAnhang.MoveNext
Wend
End SubPfad "C:\...." ist natürlich noch nicht vollständig.
Zusätzlich nochmals die Beziehungen.
Vermutlich wäre das zweite Beispiel in der Microsoft-Seite für mich der besser Anwendungsfall, aber das ist zu hoch für mich.
Vielleicht hätte ja jemand eine Idee, würde mich freuen.
Gruss
mad
Dim Pf As String
Dim Dat As String
Dim Ext As String
Dim FileName As String
Dim I As Integer
I=1
pf = pfad
Dat = Dateinamen
Ext = extension
FileName = pf & pfad & I & "." & ext
START:
If Dir (Filename) = "" then
DeinFileName = Filename
Else
I=I+1
Filename = FileName = pf & pfad & I & "." & ext
goto START
end if
Hallo Dex,
da ich mit den VBA-Codes nicht sehr bewandert bin, hätte ich noch ein paar Fragen:
ZitatDeinFileName = Filename
"DeinFileName" ist das das Feld in dem die Anlagen abgelegt sind? Bei mir "DokuAnlage"!
Wie weis der Code in welches Verzeichnis die Dokumente aus dem Anlagenfeld "DokuAnlage" gespeichert werden soll? bzw. wo difiniere ich dieses?
Gruss
mad
Hallo,
ZitatWie weis der Code in welches Verzeichnis die Dokumente aus dem Anlagenfeld "DokuAnlage" gespeichert werden soll? bzw. wo difiniere ich dieses?
Ursächlich musst Du(!) wissen, welches Verzeichnis benutzt werden soll.
Es ist sinnvoll, ein vorher bestimmtes Verzeichnis (z. B. "DBDateien") unterhalb des DB-Datei-Verzeichnisses (C:\PrüfDB") zu erstellen.
---> "C:\PrüfDB\DBDateien"
Der String "DBDateien" kann im VBA-Code als Konstante hinterlegt werden (oder besser und flexibler in einer Parametertabelle)
Das aktuelle DB-Datei-Verzeichnis kann im VBA-Code mit "Currentproject.Path" ermittelt werden und damit der komplette Pfad zu den Dateien zusammengesetzt werden:
Dim strPfad As String
Const DocDir as String = "DBDateien"
strPfad = Currentproject.Path & "\" & DocDir & "\"
If Dir(strPfad, vbDirectory) = "" Then MkDir strPfad
.
.
.
rsAnhang.Fields("FileData").SaveToFile strPfad & rsAnhang.Fields("FileName")
.
.
Es ist nur ein Weg wie die Zahl zu bekommen. Der Code untersucht fals File mit solchem Name schon im deinem Directory existiert. Fals es existiert, bekommt dein File folgenden Zahl. Zb. Fals Files Bild1, Bild2, ... Bild4 existieren, bekommt dein File den Namen Bild5.
Zitat von: mad am Juni 14, 2020, 09:34:51
Wie weis der Code in welches Verzeichnis die Dokumente aus dem Anlagenfeld "DokuAnlage" gespeichert werden soll? bzw. wo difiniere ich dieses?
Es ist Path deines Directories und es wird in Variable pf definiert.
Zitat von: mad am Juni 14, 2020, 09:34:51
ZitatDeinFileName = Filename
"DeinFileName" ist das das Feld in dem die Anlagen abgelegt sind? Bei mir "DokuAnlage"!
Es ist der Name deines Dokuments. Ich weiss nicht woher du es bekomst.
Enschuldigung wegen meiner schlechten Deutsch.
Gruss
Nur nochmals zu Sicherheit,
@Franz,
beziehst Du Dich auf die Antwort #2 oder auf die vom Dex (#3)?
Gruss
mad
Zitat von: mad am Juni 13, 2020, 17:47:34
Habe das versucht auf meinen Fall anzuwenden, laufe aber bereits in der zweiten Zeile
ZitatSet rsDokument = db.OpenRecordset("DokuAutoNr")
auf den Laufzeitfehler 424.
OpenRecordset erwartet den Namen einer Abfrage oder Tabelle oder ein SQL Statement als erstes Argument. -
DokuAutoNr scheint mir keines davon zu sein. ;-)
Übrigens, du machst es anderen einfacher dir zu helfen, wenn du nicht nur eine Fehlernummer, die kein Mensch alle auswendig weiß, sondern auch den Fehlertext angibst.
Zitat von: Dex am Juni 13, 2020, 21:53:46
START:
If Dir (Filename) = "" then
[...]
Else
[...]
goto START
end if
Eine Schleife über eine Sprungmarke zu implementieren ist keine gute Idee.
Die Intention und der Code-Block einer Schleife ist mit den entsprechenden Schlüsselworten (For/Do/While/etc) sofort offensichtlich erkennbar. Mit einer Sprungmarke muss man jede einzelne Zeile anschauen, um die grobe Intention des kompletten Blocks zu erkennen.
Hallo Zusammen,
das Zählen von der Beschreibung von "Dex" benötige ich garnicht mehr.
Ich benötige nur noch das exportieren aller Dateien die in der "tblDokumente" im Feld "DokuAnlage" abgelegt sind, in das nachfolgende Verzeichnis:
"C:\Users\Benutzer\Documents\Feuerwehr\Datenbank\FF_DB_Tabellen\Export_DB"
Hier mein aktueller Code:
Public Sub btnExport_Click()
Dim strPfad As String
Const DocDir As String = "DBDateien"
strPfad = CurrentProject.Path & "\" & DocDir & "\"
If Dir(strPfad, vbDirectory) = "" Then MkDir strPfad
Set rsDokument = db.OpenRecordset("DokuAutoNr")
Set rsAnhang = rsDokument.Fields("DokuAnlage").Value
While Not rsAnhang.EOF
rsAnhang.Fields("FileData").SaveToFile strPfad & rsAnhang.Fields("FileName")
rsAnhang.MoveNext
Wend
End Sub
Beim ausführen kommt die Fehlermeldung 424 (siehe Bild - LZF-424). Nach Debuggen wird der Code wie im Bild im Anhang "debuggen" merkiert.
Zur Info habe ich noch ein Bild (tblDukomente.png) meiner Tabelle hinzugefügt.
Gruss
mad
Zitat von: mad am Juni 14, 2020, 12:51:34
Beim ausführen kommt die Fehlermeldung 424 (siehe Bild - LZF-424). Nach Debuggen wird der Code wie im Bild im Anhang "debuggen" merkiert.
Da fehlt vorher im Code noch:
Set db = CurrentDbAußerdem schau dir mein voriges Posting an.
Hallo,
bin mit nicht ganz sicher!
Habe
Zitat...
If Dir(strPfad, vbDirectory) = "" Then MkDir strPfad
Set db = CurrentDb
Set rsDokument = db.OpenRecordset("DokuAutoNr")
...
in den Code eingebaut, hoffentlich an der richtigen Stelle?
Danach habe ich folgende Fehlermeldung erhalteN (anhag: LZF_3078).
Habe dann noch "DokuAutoNr" gegen "tblDokumente" ersetzt. Hoffe das war mit deinem Hinweis
ZitatAußerdem schau dir mein voriges Posting an.
gemeint. Nun bekomme ich keine Fehlermeldung mehr.
Aber wo/wie müsste ich jetzt noch das Zielverzeichnis integrieren?
Gruss
mad
Zitat von: mad am Juni 14, 2020, 13:51:19
Habe dann noch "DokuAutoNr" gegen "tblDokumente" ersetzt. Hoffe das war mit deinem Hinweis [...] gemeint. Nun bekomme ich keine Fehlermeldung mehr.
Aber wo/wie müsste ich jetzt noch das Zielverzeichnis integrieren?
Ja, genau darauf zielte mein Hinweis ab.
Bzgl. des Zielverzeichnisses solltest du mit ein wenig Eigeninitiative schnell zum Ziel (in doppelter Hinsicht) kommen.
Z.B. mit einem Blick in die Dokumentation der
SaveToFile-Methode (https://docs.microsoft.com/de-de/office/client-developer/access/desktop-database-reference/field2-savetofile-method-dao).
Hallo,
zum angeben des Wunsch-Verzeichnisses, denke ich das ist sich um diese Code-Zeile aus der Dokumentation handelt:
ZitatrsPictures.Fields("FileData").SaveToFile _
"C:\Documents and Settings\Username\My Documents"
aktueller Code:
Public Sub btnExport_Click()
' Dim strPfad As String
' Const DocDir As String = "DBDateien"
' strPfad = CurrentProject.Path & "\" & DocDir & "\"
' If Dir(strPfad, vbDirectory) = "" Then MkDir strPfad
Set db = CurrentDb
Set rsDokument = db.OpenRecordset("tblDokumente")
Set rsAnhang = rsDokument.Fields("DokuAnlage").Value
While Not rsAnhang.EOF
rsAnhang.Fields("FileData").SaveToFile _
"C:\Users\mad\Documents\Feuerwehr\Datenbank\FF_DB_Tabellen\Export_DB"
rsAnhang.MoveNext
Wend
End SubNun legt er das Verzeichnis "DBDateien" an, allerdings leer. (Änderung: Habe die ersten vier Zeilen mal weggelassen.) Und legt er eine Datei im Wunsch-Verzeichnis an. Allerdings eben nur eine. Es ist immer die Datei aus dem ersten Datensatz egal wo ich im Formular stehe. Also doppelte Dateien gibt es in der "tblDokumente" nicht, das habe ich überprüft. Es sollten eigentlich 1160 Dateien aus 666 Datensätzen kopiert werden.
Wie springt der Code zum nächsten Datensatz?
Ich vermute das es sich um das Code-Ende aus der Dokumentation handelt?
Zitat
.
.
.
Loop
rsA.Close
'Next record
rst.MoveNext
Loop
rst.Close
dbs.Close
Set fld = Nothing
Set rsA = Nothing
Set rst = Nothing
Set dbs = Nothing
End Function
oder liege ich Falsch?
rsA steht bei mir für rsAnhang, oder?
Nur für was steht das rst. in meinem Code?
Und was sagt das Wend aus?
Gruss
mad
@mad
Tu dir doch einen Gefallen und richte mal die Optionen im VB-Editor
brauchbar ein, - Bild anbei. Was die einzelnen Häkchen bewirken
erfährst du bei einem Klick auf den Hilfe-Button (solltest du unbedingt
lesen).
Zum Problem. Warum zeigst du nicht den ganzen Originalcode?
Aus dem Ausschnitt ist aber zu entnehmen, das da zwei Schleifen
ineinander laufen, was bei dir nicht zu sehen ist.
Vermutlich läuft auch dort (wie bei dir) die äussere Schleife durch
die "tbl_Dokumente" (oder wie die da eben heisst = rst). Die innere
Schleife läuft über die unsichtbare Tabelle des Anlagefeldes, in der die
Dokumente gespeichert sind ( = rstA).
Die Anpassung ist dir da wohl nicht so recht gelungen.
gruss ekkehard
P.S. Noch ein Tipp, - nachdem du die Optionen angepasst hast, setzt
du an den Anfang der Prozedur einen Haltepunkt und lässt den Code
im Einzelschrittmodus durchlaufen. Da siehst du wann der Code was
macht (machen will) und kannst dir die Werte von Variablen anzeigen
lassen (siehe in der o.a. Hilfe).
gruss ekkehard
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.....
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
@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