主要的代码:
Private Sub Form_Open(Cancel As Integer)
On Error Resume Next
Call BinExport
Me.GRBrowser.Navigate strPfadDB() & "gr.html"
End Sub
Private Function BinExport()
Dim DB As Database, rs As Recordset, FrNum As Long, BinData() As Byte
Set DB = CurrentDb
Set rs = DB.OpenRecordset("select * from tblJagd order by namen", dbOpenSnapshot)
rs.MoveFirst
For I = 1 To 4
FrNum = FreeFile
If I = 1 Then Open strPfadDB() & "gr.html" For Binary As #FrNum
If I = 2 Then Open strPfadDB() & "hor2.gif" For Binary As #FrNum
If I = 3 Then Open strPfadDB() & "wolf.gif" For Binary As #FrNum
If I = 4 Then Open strPfadDB() & "hunde.gif" For Binary As #FrNum
ReDim BinData(rs("objekt").FieldSize)
BinData() = rs("objekt").GetChunk(0, rs("objekt").FieldSize)
Put #FrNum, , BinData()
Close #FrNum
Erase BinData
rs.MoveNext
Next
rs.Close
DB.Close
Set rs = Nothing
Set DB = Nothing
End Function
Private Function strPfadDB() As String
Dim strName As String, Z As Byte
strName = CurrentDb.Name
For Z = 1 To Len(strName)
If Mid(strName, Z, 1) = "\" Then Q = Z
Next
strPfadDB = Left(strName, Q)
End Function
附 件:
点击附件下载
演 示: