MS-Office-Forum

Zurück   MS-Office-Forum > Microsoft Access & Datenbanken > Microsoft Access - Code Archiv
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Thema geschlossen
Ads
Themen-Optionen Ansicht
Alt 09.01.2004, 17:58   #1
Sascha Trowitzsch
MOF Guru
MOF Guru
Standard Codebeispiel - Dateien binär in Access speichern

Dateien in Access speichern



Es gibt eine für meine Begriffe merkwürdige Scheu, in Access-Datenbanken binäre Daten abzuspeichern.
Dabei kann das recht nützlich sein.
Die wahrscheinlich häufigste Anwendung ist das Abspeichern von Bilddateien ohne die Datenbank aufzublähen.

Möglicherweise liegt es daran, dass die entsprechenden Methoden (GetChunk, AppendChunk)
relativ unbekannt sind und sich selten in Codebeispielen finden.
Darum hier ein Beispiel, das allgemein verwendbar ist...


Code:

'***************************************************************************
'************     Modul mdlBinaries für Access >=97     ********************
'*******    Beliebige Dateien binär in der Datenbank speichern    **********
'****************    01/2004, Sascha Trowitzsch     ************************
'***************************************************************************
 
Option Explicit
Option Compare Database
 
'***************************************************************************
'Funktion 'AddBinFile' fügt der Tabelle tblBinary die Datei sFileName hinzu.
' Falls die Tabelle nicht existiert wird sie neu angelegt.
' Ergebnis der Funktion ist True bei Erfolg
'***************************************************************************
Function AddBinFile(sFileName As String) As Boolean
Dim F As Integer
Dim arrBin() As Byte
Dim rs As DAO.Recordset
 
    On Error GoTo Errr
 
    'Fehlertests...
    If Not tblBinExists(True) Then Err.Raise vbObjectError + 1, "mdlBinary", _
                                    "Binärtabelle konnte nicht erstellt werden!"
    If Dir(sFileName) = "" Then Err.Raise vbObjectError + 2, "mdlBinary", _
                                    "Datei " & sFileName & "existiert nicht!"
    'Datei einlesen in Byte-Array...
    F = FreeFile
    Open sFileName For Binary As #F
    ReDim arrBin(LOF(F) -1)
    Get #F, , arrBin()
    Close #F
 
    'Byte-Array in Tabelle in Binärfeld abspeichern (> .AppendChunk!)
    Set rs = DBEngine(0)(0).OpenRecordset("tblBinary", dbOpenDynaset)
    rs.AddNew
    rs("FileName") = ExtractFileName(sFileName)
    rs("binary").AppendChunk arrBin()
    rs.Update
    rs.Close
    AddBinFile = True
 
fExit:
    Reset
    Erase arrBin
    Set rs = Nothing
    Exit Function
Errr:
    MsgBox Err.Description
    Resume fExit
End Function
  '***************************************************************************** 'Funktion 'RestoreBinFile' stellt eine Datei aus der Binär-Tabelle wieder her. ' sFileName ist Dateiname (ohne Pfad). ' sPath ist das Verzeichnis, in dem die Datei wiederhergestellt werden soll. ' Overwrite ist optional und standardmäßig True, ' d.h. eine bereits existierende Datei gleichen Namens wird überschrieben. ' Ergebnis der Funktion ist True bei Erfolg '***************************************************************************** Function RestoreBinFile(sFileName, sPath As String, Optional Overwrite As Boolean = True) As Boolean Dim F As Integer Dim lSize As Long Dim arrBin() As Byte Dim rs As DAO.Recordset   On Error GoTo Errr   If Not tblBinExists Then Err.Raise vbObjectError + 3, "mdlBinary", _ "Binärtabelle 'tblBinary' existiert nicht in dieser Datenbank!" If Right(sPath, 1) <> "\" Then sPath = sPath & "\" If Dir(sPath, vbDirectory) = "" Then Err.Raise vbObjectError + 4, "mdlBinary", _ "Verzeichnis " & sPath & " existiert nicht!" If (Dir(sPath & sFileName) <> "") And Not Overwrite Then Err.Raise vbObjectError + 4, _ "mdlBinary", "Datei " & sFileName & " existiert bereits!" Set rs = DBEngine(0)(0).OpenRecordset("tblBinary", dbOpenDynaset) rs.FindFirst "[FileName]='" & sFileName & "'" If rs.NoMatch Then Err.Raise vbObjectError + 5, "mdlBinary", _ "Das Binär-File " & sFileName & " existiert nicht in der Tabelle 'tblBinary!'" Else lSize = rs.Fields("binary").FieldSize ReDim arrBin(lSize - 1) arrBin = rs.Fields("binary").GetChunk(0, lSize) F = FreeFile Open sPath & sFileName For Binary As #F Put #F, , arrBin Close #F End If rs.Close RestoreBinFile = True   fExit: Reset Erase arrBin Set rs = Nothing Exit Function Errr: MsgBox Err.Description Resume fExit End Function
  'Hilfsfunktion 'tblBinExists': 'Überprüfen, ob Tabelle "tblBinary" existiert; falls ja, dann Rückgabe: True 'Falls Create=True wird sie erstellt, wenn sie noch nicht existiert Private Function tblBinExists(Optional Create As Boolean = False) As Boolean Dim S As String On Error Resume Next DBEngine(0)(0).TableDefs.Refresh S = DBEngine(0)(0).TableDefs("tblBinary").Name tblBinExists = (Err.Number = 0) If Create And Not tblBinExists Then tblBinExists = CreateBinTable End Function
  'Hilfsfunktion 'CreateBinTable': 'Erzeugen der Tabelle 'tblBinary' ' Rückgabe: True bei Erfolg Private Function CreateBinTable() As Boolean   On Error GoTo Errr   DBEngine(0)(0).Execute "CREATE TABLE tblBinary (ID COUNTER CONSTRAINT ID PRIMARY KEY, " & _ "FileName CHAR(255) NOT NULL, [binary] IMAGE NOT NULL)" 'Die Tabelle enthält nun die Felder: ' ID (Autowert, pKey) | FileName (Text 255) | binary (OLE-Feld) DBEngine(0)(0).TableDefs.Refresh 'Der folgende Block bzw. einzelne Elemente ist/sind optional... With DBEngine(0)(0).TableDefs("tblBinary") .Fields("FileName").Properties.Append .Fields("FileName").CreateProperty( _ "UnicodeCompression", dbBoolean, True) .Properties.Append .CreateProperty("DatasheetFontName", dbText, "Arial") .Properties.Append .CreateProperty("DatasheetFontHeight", dbInteger, 8) .Attributes = dbSystemObject '...Tabelle ist versteckt! '(Nur sichtbar mit Option ' 'Systemobjekte', kann aber auch dann nicht editiert werden!) End With CreateBinTable = True fExit: Exit Function Errr: Resume fExit End Function
  'Hilfsfunktion 'ExtractFileName': 'Gibt nur den Dateinamen aus dem vollständige Pfad zurück Function ExtractFileName(sFilePath As String) As String Dim n As Long   For n = Len(sFilePath) To 1 Step -1 If Mid(sFilePath, n, 1) = "\" Then Exit For Next n ExtractFileName = Mid(sFilePath, n + 1)   'Ab A2000 reicht allein diese Zeile (!): 'ExtractFileName = Split(sFilePath, "\")(UBound(Split(sFilePath, "\")))   End Function
 

Hier eine Beispielroutine, die den Einsatz der beiden Funktionen verdeutlicht:



Code:

Sub TestBinaryStorage()
 
    'Die Datei msjet40.dll in die Datenbank einlesen und binär speichern
    AddBinFile "c:\winnt\system32\msjet40.dll"
    'Datei msjet40.dll aus Binärtabelle im Verzeichnis c:\ wiederherstellen
    RestoreBinFile "msjet40.dll", "c:\", True
    '...Das Ganze ist also quasi eine Kopierfunktion ;-)
 
End Sub

Geändert von Sascha Trowitzsch (16.02.2010 um 12:06 Uhr).
Sascha Trowitzsch ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Alt 09.01.2004, 18:31   #2
TommyK
MOF Meister
MOF Meister
Standard

Hallo Sascha,

ausser mit Bildern habe ich die Sache so noch gar nicht gesehen.

Dein Code hat aber einen Fehler.
In der Hilfsfunktion "CreateBinTable" ist der Code fehlerhaft.
Wenn ich den Error-Handler abschalte kommt der Fehler 3920, Fehler in SQL-Statement. Hab aber den Fehler nicht gefunden.
Ich bin drauf gekommen weil sonst der Fehler kam, Tabelle nicht vorhanden.


Ich hab dann die Tabelle von Hand erstellt und es klappte prima.

__________________

Gruss TommyK

TKSoft-Online | Beispiele im MOF Code-Archiv
Meine Software:Windows 10 Pro 64Bit, Windows 7 Ultimate 64Bit, Office 2007 Pro SP2, Office 2010 Pro, Office 2013 Pro, Office 2016 Pro, Office 2019 Pro, VB6 Pro SP6, VS2017
TommyK ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Alt 09.01.2004, 19:41   #3
Sascha Trowitzsch
Threadstarter Threadstarter
MOF Guru
MOF Guru
Standard

Danke für den Test.
Unter A2000 funktioniert die Tabellendefinitions-Syntax.
In A97 nicht. Da muss der Primary Key über CONSTRAINT angelegt werden:

Statt:
Code:

DBEngine(0)(0).Execute "CREATE TABLE tblBinary " & _
    "(ID COUNTER PRIMARY KEY, " & _
    "FileName CHAR(255) NOT NULL, " & _ 
    "[binary] IMAGE NOT NULL)"
muss es heißen:
Code:

DBEngine(0)(0).Execute "CREATE TABLE tblBinary " & _
    "(ID COUNTER CONSTRAINT ID PRIMARY KEY, " & _
    "FileName CHAR(255) NOT NULL, " & _ 
    "[binary] IMAGE NOT NULL)"
Ich habe den Code oben damit aktualisiert. (Weil er ebenso unter A2000/XP läuft.)

Ciao, Sascha

__________________

Microsoft Access MVP
O2k bis O2010, VB6, VS2008, Delphi7, ...
Bitte keine ungefragten E-Mails. Probleme werden hier gelöst.
Bitte beachten: Grundlegendes zum Access-Forum

Knowhow auf Access-im-Unternehmen | Das Access 2007 Praxisbuch für Entwickler | www.mossTOOLs.de
Sascha Trowitzsch ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Alt 09.01.2004, 20:57   #4
TommyK
MOF Meister
MOF Meister
Standard

Alles klar, jetzt läuft es auch unter A97.

__________________

Gruss TommyK

TKSoft-Online | Beispiele im MOF Code-Archiv
Meine Software:Windows 10 Pro 64Bit, Windows 7 Ultimate 64Bit, Office 2007 Pro SP2, Office 2010 Pro, Office 2013 Pro, Office 2016 Pro, Office 2019 Pro, VB6 Pro SP6, VS2017
TommyK ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Alt 17.03.2004, 06:47   #5
Gast
Standard

Hallo,
meine Accesstabelle enthält als Ole-Objekt ein Worddokument, dies würde ich gerne in ein Worddokument einfügen. Wie mache ich aus dem mit Getchunk erhaltenem Array was Word-artiges? Am liebsten ein Rangeobjekt.
Dietmar
 
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Alt 22.09.2004, 11:59   #6
schwimmcoach
Neuer Benutzer
Neuer Benutzer
Standard

Hallo liebe Gemeinde,

ich habe das von Sasha entwickelte Demo "Bilder binär Speichern" ausprobiert und wollte nachfragen, ob man dies so erweitern kann, dass auch TIFF Dateien abspeicherbar sind?

Danke & Gruss,

Schwimmcoach
schwimmcoach ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Alt 22.09.2004, 14:06   #7
Sascha Trowitzsch
Threadstarter Threadstarter
MOF Guru
MOF Guru
Standard

Kann man doch ?!

BTW: Die Frage ist in diesem Thread nicht ganz richtig aufgehoben. Eine TIFF-Datei kannst du mit obigem Code speichern und wiederherstellen. Deine Frage zielt wohl eher darauf ab, wie man in Access das TIFF dann darstellen kann. Das ist aber ein anderes Problem. Es geht jedenfalls nur mit der Methode Pix(1)

Ciao, Sascha

__________________

Microsoft Access MVP
O2k bis O2010, VB6, VS2008, Delphi7, ...
Bitte keine ungefragten E-Mails. Probleme werden hier gelöst.
Bitte beachten: Grundlegendes zum Access-Forum

Knowhow auf Access-im-Unternehmen | Das Access 2007 Praxisbuch für Entwickler | www.mossTOOLs.de
Sascha Trowitzsch ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Alt 01.02.2005, 13:23   #8
barbaros1
Neuer Benutzer
Neuer Benutzer
Traurig

Hallo,
bin neu hier im Forum und wollte fragen ob ich diese Chunk Methoden auch für MP3's benutzen kann.

Danke im vorraus allen die mir Helfen wollen. ;-)
barbaros1 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Alt 01.02.2005, 16:51   #9
Sascha Trowitzsch
Threadstarter Threadstarter
MOF Guru
MOF Guru
Standard

Man kann damit jede beliebige Datei abspeichern/wieder auslesen.

Ciao, Sascha

__________________

Microsoft Access MVP
O2k bis O2010, VB6, VS2008, Delphi7, ...
Bitte keine ungefragten E-Mails. Probleme werden hier gelöst.
Bitte beachten: Grundlegendes zum Access-Forum

Knowhow auf Access-im-Unternehmen | Das Access 2007 Praxisbuch für Entwickler | www.mossTOOLs.de
Sascha Trowitzsch ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Alt 25.02.2005, 13:58   #10
brisc
Neuer Benutzer
Neuer Benutzer
Standard

Hallo,
Man kann nur die Daten nämlich nicht in einem Control anzeigen und auch nicht mehr in der Datenbank durch die OLE-Applikation bearbeiten lassen, sondern muß dafür die Datei erstmal wieder irgendwohin speichern.

Wie kann man in Abwandlung der hier verwendeten Form der Speicherung die Dateien "ganz normal" als OLE-Objekt einfügen und was tut man, um die Anzeige eines Dateneintrags aus VB-Code heraus aufzurufen?


Gruß,
brisc
brisc ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Alt 26.02.2005, 09:53   #11
Sascha Trowitzsch
Threadstarter Threadstarter
MOF Guru
MOF Guru
Standard

Wie du selbst sagst: In der Regel muss erst die Datei physisch wiederhergestellt werden, bevor man sie weiterverwenden kann.
Soll die Datei Grundlage zur Darstellung in einem Control sein, so muss sie also eben erst "zwischengespeichert" und anschließend im Control eingelesen werden. Für Bilder (bmp, gif, jpg) geht das aber auch ohne Zwischenspeicherung durch Umwandlung im RAM. (Siehe http://www.moss-soft.de/public/pix.zip)

Was "OLE-Objekte" angeht: Ein OLE-Objekt ist nunmal was anderes, als eine Datei. Wenn z.B. ein Excel-Sheet in ein OLE-Feld gespeichert wird, dann ist ja nicht einfach die Excel-Datei in selbigem drin, sondern es findet in Access eine Konvertierung in das OLE-Format statt, das außer den Daten zusätzliche Informationen zum OLE-Server etc. enthält. Das Format ist indessen nicht dokumentiert und deshalb ist es auch nicht möglich, aus einer binär gespeicherten Datei direkt ein OLE-Objekt zur Anzeige in einem Objektfeld eines Formulars zu machen.
Für eine Excel-Datei sähe der Vorgang also so aus:
- excel.xls mit obigem Code binär speichern
- In Formular mit Objektfeld im Ereignis "Beim Anzeigen" den Code oben RestoreBinFile aufrufen, um die excel.xls wiederherzustellen.
- Die excel.xls im OLE-Feld (OLE1) anzeigen mit:
Code:

OLE1.Class = "Excel.Sheet"
    OLE1.OLETypeAllowed = acOLELinked
    Me.OLE1.SourceDoc = "c:\excel.xls"
    Me.OLE1.Action = acOLECreateLink
Anders geht es nicht.

Ciao, Sascha

__________________

Microsoft Access MVP
O2k bis O2010, VB6, VS2008, Delphi7, ...
Bitte keine ungefragten E-Mails. Probleme werden hier gelöst.
Bitte beachten: Grundlegendes zum Access-Forum

Knowhow auf Access-im-Unternehmen | Das Access 2007 Praxisbuch für Entwickler | www.mossTOOLs.de
Sascha Trowitzsch ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Alt 03.03.2006, 01:24   #12
DaveRichter
Neuer Benutzer
Neuer Benutzer
Standard

Hallo,

ich habe das obere beispiel pix.zip für eine Cover anzeige in meine Datenbank eingebaut, allerdings wird beim schreiben dieser bilder mein Filter nicht beachtet sondern es wird immer in den ID 1 geschrieben

Code:

Dim strFile As String, b As Boolean, S As String, n As Long
    On Error GoTo Fehler

    If MsgBox("Überschreiben?", vbYesNo Or vbQuestion) = vbNo Then Exit Sub
    WizHook.Key = 51488399
    Call WizHook.OpenPictureFile(strFile, b)
    If b Then Exit Sub
    S = Mid(strFile, InstrRev(strFile, "\") + 1)
    n = InStr(1, S, ".")
    If n <> 0 Then S = Left(S, n - 1)
    InsertPixFile strFile, S, Me.CurrentRecord - 1
    Me.Requery
    DoCmd.GoToRecord , , acLast
Ende:
    Exit Sub

Fehler:
    MsgBox Err.Description
    Resume Ende
End Sub
ich denke mal es hakt an Me.CurrentRecord - 1 ich weis aber nicht in was ich es ändern muss damit es funktioniert me.ID habe ich schon versucht ohne erfolg, dann speichert er gar nichts mehr :-(

danke für eure hilfe

MFG

Dave

__________________

MFG

DaveRichter
**Der Computer ist die logische Weiterentwicklung des Menschen: Intelligenz ohne Moral.**
DaveRichter ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Alt 07.03.2006, 12:47   #13
Sascha Trowitzsch
Threadstarter Threadstarter
MOF Guru
MOF Guru
Standard

CurrentRecord gibt nicht die ID deines Datensatzes an, sondern dessen Position innerhalb der Datensätze! Das ist der falsche Parameter für die InsertPixFile-Funktion.
Du musst schon die ID das Datensatzes verwenden, was zur Vorraussetzng hat, dass deine zugrundeliegende Tabelle bzw. das Formular ein eindeutig indiziertes Feld ID besitzt!

Ansonsten schließe ich auch diesen Thread, weil die Fragen langsam nichts mehr mit dem eingangs dargestellten Code zutun haben.
Es ist das Code-Archiv! (Kein Fragen-Archiv)

Gruß, Sascha

__________________

Microsoft Access MVP
O2k bis O2010, VB6, VS2008, Delphi7, ...
Bitte keine ungefragten E-Mails. Probleme werden hier gelöst.
Bitte beachten: Grundlegendes zum Access-Forum

Knowhow auf Access-im-Unternehmen | Das Access 2007 Praxisbuch für Entwickler | www.mossTOOLs.de
Sascha Trowitzsch ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Ads
Thema geschlossen


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 10:36 Uhr.



Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.

Copyright ©2000-2018 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günter Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.