读取/写入二进制数据,可用ADO中GetChunk /AppendChunk方法实现!'BeginAppendChunkVB 'To integrate this code 'replace the data source and initial catalog values 'in the connection string
Public Sub AppendChunkX() 'recordset and connection variables Dim Cnxn As ADODB.Connection Dim strCnxn As String Dim rstPubInfo As ADODB.Recordset Dim strSQLPubInfo As String 'record variables Dim strPubID As String Dim strPRInfo As String Dim lngOffset As Long Dim lngLogoSize As Long Dim varLogo As Variant Dim varChunk As Variant Dim strMsg As String
Const conChunkSize = 100 ' Open a connection Set Cnxn = New ADODB.Connection strCnxn = "Provider=sqloledb;Data Source=MyServer;Initial Catalog=Pubs;User Id=sa;Password=; " Cnxn.Open strCnxn
' Open the pub_info table with a cursor that allows updates Set rstPubInfo = New ADODB.Recordset strSQLPubInfo = "pub_info" rstPubInfo.Open strSQLPubInfo, Cnxn, adOpenKeyset, adLockOptimistic, adCmdTable
' Prompt for a logo to copy strMsg = "Available logos are : " & vbCr & vbCr Do While Not rstPubInfo.EOF strMsg = strMsg & rstPubInfo!pub_id & vbCr & _ Left(rstPubInfo!pr_info, InStr(rstPubInfo!pr_info, ",") - 1) & _ vbCr & vbCr rstPubInfo.MoveNext Loop
strMsg = strMsg & "Enter the ID of a logo to copy:" strPubID = InputBox(strMsg)
' Copy the logo to a variable in chunks rstPubInfo.Filter = "pub_id = '" & strPubID & "'" lngLogoSize = rstPubInfo!logo.ActualSize Do While lngOffset < lngLogoSize varChunk = rstPubInfo!logo.GetChunk(conChunkSize) varLogo = varLogo & varChunk lngOffset = lngOffset + conChunkSize Loop
' Get data from the user strPubID = Trim(InputBox("Enter a new pub ID" & _ " [must be > 9899 & < 9999]:")) strPRInfo = Trim(InputBox("Enter descriptive text:")) ' Add the new publisher to the publishers table to avoid ' getting an error due to foreign key constraint Cnxn.Execute "INSERT publishers(pub_id, pub_name) VALUES('" & _ strPubID & "','Your Test Publisher')"
' Add a new record, copying the logo in chunks rstPubInfo.AddNew rstPubInfo!pub_id = strPubID rstPubInfo!pr_info = strPRInfo lngOffset = 0 ' Reset offset Do While lngOffset < lngLogoSize varChunk = LeftB(RightB(varLogo, lngLogoSize - lngOffset), _ conChunkSize) rstPubInfo!logo.AppendChunk varChunk lngOffset = lngOffset + conChunkSize Loop rstPubInfo.Update
' Show the newly added data MsgBox "New record: " & rstPubInfo!pub_id & vbCr & _ "Description: " & rstPubInfo!pr_info & vbCr & _ "Logo size: " & rstPubInfo!logo.ActualSize ' Delete new records because this is a demo rstPubInfo.Requery Cnxn.Execute "DELETE FROM pub_info " & _ "WHERE pub_id = '" & strPubID & "'" Cnxn.Execute "DELETE FROM publishers " & _ "WHERE pub_id = '" & strPubID & "'" ' clean up rstPubInfo.Close Cnxn.Close Set rstPubInfo = Nothing Set Cnxn = NothingEnd Sub 'EndAppendChunkVB
将数据读出保存为临时word文件,再用word打开
'将任何文件从数据库中下载到本地: Public Function LoadFile(ByVal col As ADODB.Field, ByVal FileName As String) As Boolean '获得binary数据 On Error GoTo myerr: Dim arrBytes() As Byte Dim FreeFileNumber As Integer lngsize = col.ActualSize arrBytes = col.GetChunk(lngsize) FreeFileNumber = FreeFile Open FileName For Binary Access Write As #FreeFileNumber Put #FreeFileNumber, , arrBytes Close #FreeFileNumber LoadFile = True myerr: If Err.Number <> 0 Then LoadFile = False Err.Clear End If End Function
'将文件从本地上传到数据库中 Public Function UpLoadFile(ByVal FileName, ByVal col As ADODB.Field) As Boolean On Error GoTo myerr: Dim arrBytes() As Byte Dim FreeFileNumber As Integer FreeFileNumber = FreeFile Open FileName For Binary As #FreeFileNumber n = LOF(FreeFileNumber) ReDim arrBytes(1 To n) As Byte Get #FreeFileNumber, , arrBytes Close #FreeFileNumber col.AppendChunk (arrBytes) UpLoadFile = True myerr: If Err.Number <> 0 Then UpLoadFile = False Err.Clear End If End Function
'replace the data source and initial catalog values
'in the connection string
Public Sub AppendChunkX() 'recordset and connection variables
Dim Cnxn As ADODB.Connection
Dim strCnxn As String
Dim rstPubInfo As ADODB.Recordset
Dim strSQLPubInfo As String
'record variables
Dim strPubID As String
Dim strPRInfo As String
Dim lngOffset As Long
Dim lngLogoSize As Long
Dim varLogo As Variant
Dim varChunk As Variant
Dim strMsg As String
Const conChunkSize = 100 ' Open a connection
Set Cnxn = New ADODB.Connection
strCnxn = "Provider=sqloledb;Data Source=MyServer;Initial Catalog=Pubs;User Id=sa;Password=; "
Cnxn.Open strCnxn
' Open the pub_info table with a cursor that allows updates
Set rstPubInfo = New ADODB.Recordset
strSQLPubInfo = "pub_info"
rstPubInfo.Open strSQLPubInfo, Cnxn, adOpenKeyset, adLockOptimistic, adCmdTable
' Prompt for a logo to copy
strMsg = "Available logos are : " & vbCr & vbCr
Do While Not rstPubInfo.EOF
strMsg = strMsg & rstPubInfo!pub_id & vbCr & _
Left(rstPubInfo!pr_info, InStr(rstPubInfo!pr_info, ",") - 1) & _
vbCr & vbCr
rstPubInfo.MoveNext
Loop
strMsg = strMsg & "Enter the ID of a logo to copy:"
strPubID = InputBox(strMsg)
' Copy the logo to a variable in chunks
rstPubInfo.Filter = "pub_id = '" & strPubID & "'"
lngLogoSize = rstPubInfo!logo.ActualSize
Do While lngOffset < lngLogoSize
varChunk = rstPubInfo!logo.GetChunk(conChunkSize)
varLogo = varLogo & varChunk
lngOffset = lngOffset + conChunkSize
Loop
' Get data from the user
strPubID = Trim(InputBox("Enter a new pub ID" & _
" [must be > 9899 & < 9999]:"))
strPRInfo = Trim(InputBox("Enter descriptive text:")) ' Add the new publisher to the publishers table to avoid
' getting an error due to foreign key constraint
Cnxn.Execute "INSERT publishers(pub_id, pub_name) VALUES('" & _
strPubID & "','Your Test Publisher')"
' Add a new record, copying the logo in chunks
rstPubInfo.AddNew
rstPubInfo!pub_id = strPubID
rstPubInfo!pr_info = strPRInfo lngOffset = 0 ' Reset offset
Do While lngOffset < lngLogoSize
varChunk = LeftB(RightB(varLogo, lngLogoSize - lngOffset), _
conChunkSize)
rstPubInfo!logo.AppendChunk varChunk
lngOffset = lngOffset + conChunkSize
Loop
rstPubInfo.Update
' Show the newly added data
MsgBox "New record: " & rstPubInfo!pub_id & vbCr & _
"Description: " & rstPubInfo!pr_info & vbCr & _
"Logo size: " & rstPubInfo!logo.ActualSize ' Delete new records because this is a demo
rstPubInfo.Requery
Cnxn.Execute "DELETE FROM pub_info " & _
"WHERE pub_id = '" & strPubID & "'" Cnxn.Execute "DELETE FROM publishers " & _
"WHERE pub_id = '" & strPubID & "'" ' clean up
rstPubInfo.Close
Cnxn.Close
Set rstPubInfo = Nothing
Set Cnxn = NothingEnd Sub
'EndAppendChunkVB
Public Function LoadFile(ByVal col As ADODB.Field, ByVal FileName As String) As Boolean '获得binary数据
On Error GoTo myerr:
Dim arrBytes() As Byte
Dim FreeFileNumber As Integer
lngsize = col.ActualSize
arrBytes = col.GetChunk(lngsize)
FreeFileNumber = FreeFile
Open FileName For Binary Access Write As #FreeFileNumber
Put #FreeFileNumber, , arrBytes
Close #FreeFileNumber
LoadFile = True
myerr:
If Err.Number <> 0 Then
LoadFile = False
Err.Clear
End If
End Function
'将文件从本地上传到数据库中
Public Function UpLoadFile(ByVal FileName, ByVal col As ADODB.Field) As Boolean
On Error GoTo myerr:
Dim arrBytes() As Byte
Dim FreeFileNumber As Integer
FreeFileNumber = FreeFile
Open FileName For Binary As #FreeFileNumber
n = LOF(FreeFileNumber)
ReDim arrBytes(1 To n) As Byte
Get #FreeFileNumber, , arrBytes
Close #FreeFileNumber
col.AppendChunk (arrBytes)
UpLoadFile = True
myerr:
If Err.Number <> 0 Then
UpLoadFile = False
Err.Clear
End If
End Function