PDA

Vollständige Version anzeigen : Dateien binär in Access speichern


Sascha Trowitzsch
09.01.2004, 17:58
<h2>Dateien in Access speichern</h2>

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

<h4>Hier eine Beispielroutine, die den Einsatz der beiden Funktionen verdeutlicht: </h4>

<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre><span class="TOKEN">Sub</span> TestBinaryStorage()
&nbsp;
<span class="REM"> 'Die Datei msjet40.dll in die Datenbank einlesen und bin&auml;r speichern</span>
AddBinFile &quot;c:\winnt\system32\msjet40.dll&quot;
<span class="REM"> 'Datei msjet40.dll aus Bin&auml;rtabelle im Verzeichnis c:\ wiederherstellen</span>
RestoreBinFile &quot;msjet40.dll&quot;, &quot;c:\&quot;, <span class="TOKEN">True</span>
<span class="REM"> '...Das Ganze ist also quasi eine Kopierfunktion ;-)</span>
&nbsp;
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span><hr></pre></div>

TommyK
09.01.2004, 18:31
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.

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

Statt:
DBEngine(0)(0).Execute "CREATE TABLE tblBinary " & _
"(ID COUNTER PRIMARY KEY, " & _
"FileName CHAR(255) NOT NULL, " & _
"[binary] IMAGE NOT NULL)"

muss es heißen:
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

TommyK
09.01.2004, 20:57
Alles klar, jetzt läuft es auch unter A97. :top:

Gast
17.03.2004, 06:47
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

schwimmcoach
22.09.2004, 11:59
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

Sascha Trowitzsch
22.09.2004, 14:06
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

barbaros1
01.02.2005, 13:23
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. ;-)

Sascha Trowitzsch
01.02.2005, 16:51
Man kann damit jede beliebige Datei abspeichern/wieder auslesen.

Ciao, Sascha

brisc
25.02.2005, 13:58
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

Sascha Trowitzsch
26.02.2005, 09:53
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:
OLE1.Class = "Excel.Sheet"
OLE1.OLETypeAllowed = acOLELinked
Me.OLE1.SourceDoc = "c:\excel.xls"
Me.OLE1.Action = acOLECreateLink
Anders geht es nicht.

Ciao, Sascha

DaveRichter
03.03.2006, 01:24
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

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

Sascha Trowitzsch
07.03.2006, 12:47
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