给你两个方法直接就可以用了。注意：传进去的字段必须是一个可写 的IMAGE字段。'将图片字段写入图片文件 Public Function GetImageFile(pField As ADODB.Field) As String Const MAX_LENGTH As Long = 100000 Const GRAPH_FILENAME = "CLPHOTO.jpg" Dim tVar As Variant Dim tByte() As Byte Dim tFileName As String
Open tFileName For Binary Access Write As #1 Put #1, , tByte Close #1
GetImageFile = tFileName ReDim tByte(1 To 1) End Function'将图片文件写入图片字段 Public Sub SaveImageFile(pField As ADODB.Field, pFileName As String) Dim tVar As Variant Dim tByte() As Byte Dim tLng As Long
tLng = FileLen(pFileName) ReDim tByte(1 To tLng)
Open pFileName For Binary Access Read As #1 Get #1, , tByte Close #1
Call pField.AppendChunk(tByte) ReDim tByte(1 To 1) End Sub
再给你两段使用这两个方法的示例： '读出照片 strSQL = "select * from T_CUSTOMERPHOTO where VC_CODE='" + CustomerCode + "'" Rec.Open strSQL, Adoconn, adOpenStatic
If Rec.BOF And Rec.EOF Then PHOTOFILENAME = "" Else PHOTOFILENAME = GetImageFile(Rec.Fields("R_PHOTO")) End If Rec.Close------------------------------------------------------------- '写入照片 Set Rec = New ADODB.Recordset strSQL = "select * from T_CUSTOMERPHOTO where VC_CODE='" + pCustomerCode + "'" Rec.Open strSQL, gSysUser.Adoconn, adOpenDynamic, adLockOptimistic If Rec.BOF And Rec.EOF Then Rec.AddNew End If
AppendChunk 和 GetChunk 方法范例 该范例使用 AppendChunk 和 GetChunk 方法用其他记录中的数据填写图像字段。Public Sub AppendChunkX() Dim cnn1 As ADODB.Connection Dim rstPubInfo As ADODB.Recordset Dim strCnn As String Dim strPubID As String Dim strPRInfo As String Dim lngOffset As Long Dim lngLogoSize As Long Dim varLogo As Variant Dim varChunk As Variant
txtFileName.Text = cdlOpen.FileName txtDesc.Text = cdlOpen.FileTitleEnd Sub' 这个Sub用于将选定的图片存储到数据库中Private Sub cmdSave_Click()On Error GoTo TransError Dim fs As Object Dim buf() As Byte Dim intFileId As Long Dim intFileSize As Long Dim i As Integer, j As Integer, k As Integer Set fs = CreateObject("Scripting.FileSystemObject") If Not fs.fileexists(txtFileName.Text) Then MsgBox "Can not read file! - " & txtFileName.Text Exit Sub End If
If txtDesc.Text = "" Then MsgBox "Please input the description for the file!" Exit Sub End If
intFileId = FreeFile() Open cdlOpen.FileName For Binary Access Read As #intFileId intFileSize = LOF(intFileId)
i = intFileSize \ BLOCK_SIZE j = intFileSize Mod BLOCK_SIZE ReDim buf(BLOCK_SIZE)
Screen.MousePointer = 11 DoEvents
Rem {{{{
Cnn.BeginTrans
Rst.AddNew Rst("FileName") = txtDesc.Text Rst("Key") = txtDesc.Text For k = 1 To i Get #intFileId, , buf() Rst("FileData").AppendChunk buf() Next If j <> 0 Then ReDim buf(j) Get #intFileId, , buf() Rst("FileData").AppendChunk buf() End If Rst.Update
Cnn.CommitTrans
Rem }}}}
Close #intFileId RstView.Requery datFileDesc.Refresh Screen.MousePointer = 0
txtFileName.Text = "" txtDesc.Text = ""
Exit Sub
TransError: MsgBox "Error! - " & Err.Description Err.Clear Cnn.RollbackTransEnd Sub' 在窗体加载时打开数据库连接，并进行记录集初始化Private Sub Form_Load() Dim openString As String Set Cnn = CreateObject("ADODB.Connection") Cnn.CursorLocation = adUseClient
Set datFileDesc.DataSource = RstViewEnd Sub' 在记录集发生移动时（Datagrid被单击时）显示图片Private Sub RstView_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset) Dim buf() As Byte Dim intFileId As Long Dim intFileSize As Long Dim i As Integer, j As Integer, k As Integer Dim RstTmp As Recordset If RstView.EOF() Or RstView.BOF() Then Exit Sub Set RstTmp = Cnn.Execute("Select FileData From Pic Where ID=" & RstView("ID")) intFileId = FreeFile() Open App.Path & "\" & RstView("FileName") _ For Binary Access Write As #intFileId intFileSize = RstTmp("FileData").ActualSize Debug.Print "intFileSize = " & intFileSize i = intFileSize \ BLOCK_SIZE j = intFileSize Mod BLOCK_SIZE ReDim buf(i)
Rem {{{{
For k = 1 To i buf() = RstTmp("FileData").GetChunk(BLOCK_SIZE) Put #intFileId, , buf() Next If j <> 0 Then ReDim buf(BLOCK_SIZE) buf() = RstTmp("FileData").GetChunk(j) Put #intFileId, , buf() End If
Rem }}}}
Close #intFileId pic1.Picture = LoadPicture(App.Path & "\" & RstView("FileName")) Kill App.Path & "\" & RstView("FileName")End Sub
的IMAGE字段。'将图片字段写入图片文件
Public Function GetImageFile(pField As ADODB.Field) As String
Const MAX_LENGTH As Long = 100000
Const GRAPH_FILENAME = "CLPHOTO.jpg"
Dim tVar As Variant
Dim tByte() As Byte
Dim tFileName As String
ReDim tByte(1 To pField.ActualSize)
tByte = pField.GetChunk(pField.ActualSize)
tFileName = "C:\" + GRAPH_FILENAME
Open tFileName For Binary Access Write As #1
Put #1, , tByte
Close #1
GetImageFile = tFileName
ReDim tByte(1 To 1)
End Function'将图片文件写入图片字段
Public Sub SaveImageFile(pField As ADODB.Field, pFileName As String)
Dim tVar As Variant
Dim tByte() As Byte
Dim tLng As Long
tLng = FileLen(pFileName)
ReDim tByte(1 To tLng)
Open pFileName For Binary Access Read As #1
Get #1, , tByte
Close #1
Call pField.AppendChunk(tByte)
ReDim tByte(1 To 1)
End Sub
strSQL = "select * from T_CUSTOMERPHOTO where VC_CODE='" + CustomerCode + "'"
Rec.Open strSQL, Adoconn, adOpenStatic
If Rec.BOF And Rec.EOF Then
PHOTOFILENAME = ""
Else
PHOTOFILENAME = GetImageFile(Rec.Fields("R_PHOTO"))
End If
Rec.Close-------------------------------------------------------------
'写入照片
Set Rec = New ADODB.Recordset
strSQL = "select * from T_CUSTOMERPHOTO where VC_CODE='" + pCustomerCode + "'"
Rec.Open strSQL, gSysUser.Adoconn, adOpenDynamic, adLockOptimistic
If Rec.BOF And Rec.EOF Then
Rec.AddNew
End If
Rec.Fields("VC_CODE") = pCustomerCode
Call SaveImageFile(Rec.Fields("R_PHOTO"), tFileName) 'tFilename是一个图片文件名
Rec.Update
Rec.Close
Set Rec = Nothing
该范例使用 AppendChunk 和 GetChunk 方法用其他记录中的数据填写图像字段。Public Sub AppendChunkX() Dim cnn1 As ADODB.Connection
Dim rstPubInfo As ADODB.Recordset
Dim strCnn As String
Dim strPubID As String
Dim strPRInfo As String
Dim lngOffset As Long
Dim lngLogoSize As Long
Dim varLogo As Variant
Dim varChunk As Variant
Const conChunkSize = 100 ' 打开连接
Set cnn1 = New ADODB.Connection
strCnn = "Provider=sqloledb;" & _
"Data Source=srv;Initial Catalog=pubs;User Id=sa;Password=; "
cnn1.Open strCnn
' 打开 pub_info 表。
Set rstPubInfo = New ADODB.Recordset
rstPubInfo.CursorType = adOpenKeyset
rstPubInfo.LockType = adLockOptimistic
rstPubInfo.Open "pub_info", cnn1, , , adCmdTable
' 提示复制徽标。
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)
' 将徽标复制到大块中的变量。
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
' 从用户得到数据。
strPubID = Trim(InputBox("Enter a new pub ID:"))
strPRInfo = Trim(InputBox("Enter descriptive text:"))
' 添加新记录，将徽标复制到大块中。
rstPubInfo.AddNew
rstPubInfo!pub_id = strPubID
rstPubInfo!pr_info = strPRInfo lngOffset = 0 ' 重置位移。
Do While lngOffset < lngLogoSize
varChunk = LeftB(RightB(varLogo, lngLogoSize - lngOffset), _
conChunkSize)
rstPubInfo!logo.AppendChunk varChunk
lngOffset = lngOffset + conChunkSize
Loop
rstPubInfo.Update
' 显示新添加的数据。
MsgBox "New record: " & rstPubInfo!pub_id & vbCr & _
"Description: " & rstPubInfo!pr_info & vbCr & _
"Logo size: " & rstPubInfo!logo.ActualSize ' 删除新记录，因为这只是演示。
rstPubInfo.Requery
cnn1.Execute "DELETE FROM pub_info " & _
"WHERE pub_id = '" & strPubID & "'" rstPubInfo.Close
cnn1.Close End Sub
'
' 数据库名称： picdata.mdb
' 表名称： pic
' 字段列表：
' ID 自动编号
' Key 图片描述（文本）
' FileName 图片文件名称（文本）
' FileData 图片的二进制数据（OLE对象）
'
' 使用方法：使用 Browse 按钮浏览图片，使用 Save 按钮将图片存储到数据库。Private Const BLOCK_SIZE = 1024 * 8 '设定一次读取的缓冲区大小(8K)Private Cnn As Connection
Private Rst As Recordset '用于添加数据的记录集合
Private WithEvents RstView As Recordset '用于浏览的记录集合' 这个Sub用于显示“打开文件”对话框Private Sub cmdBrowse_Click() cdlOpen.Filter = "BMP|*.bmp|GIF|*.gif|JPEG|*.jpg"
cdlOpen.FileName = ""
cdlOpen.ShowOpen
If cdlOpen.FileName = "" Then Exit Sub
Debug.Print cdlOpen.FileName
Debug.Print cdlOpen.FileTitle
txtFileName.Text = cdlOpen.FileName
txtDesc.Text = cdlOpen.FileTitleEnd Sub' 这个Sub用于将选定的图片存储到数据库中Private Sub cmdSave_Click()On Error GoTo TransError Dim fs As Object
Dim buf() As Byte
Dim intFileId As Long
Dim intFileSize As Long
Dim i As Integer, j As Integer, k As Integer Set fs = CreateObject("Scripting.FileSystemObject")
If Not fs.fileexists(txtFileName.Text) Then
MsgBox "Can not read file! - " & txtFileName.Text
Exit Sub
End If
If txtDesc.Text = "" Then
MsgBox "Please input the description for the file!"
Exit Sub
End If
intFileId = FreeFile()
Open cdlOpen.FileName For Binary Access Read As #intFileId
intFileSize = LOF(intFileId)
i = intFileSize \ BLOCK_SIZE
j = intFileSize Mod BLOCK_SIZE
ReDim buf(BLOCK_SIZE)
Screen.MousePointer = 11
DoEvents
Rem {{{{
Cnn.BeginTrans
Rst.AddNew
Rst("FileName") = txtDesc.Text
Rst("Key") = txtDesc.Text
For k = 1 To i
Get #intFileId, , buf()
Rst("FileData").AppendChunk buf()
Next
If j <> 0 Then
ReDim buf(j)
Get #intFileId, , buf()
Rst("FileData").AppendChunk buf()
End If
Rst.Update
Cnn.CommitTrans
Rem }}}}
Close #intFileId
RstView.Requery
datFileDesc.Refresh
Screen.MousePointer = 0
txtFileName.Text = ""
txtDesc.Text = ""
Exit Sub
TransError: MsgBox "Error! - " & Err.Description
Err.Clear
Cnn.RollbackTransEnd Sub' 在窗体加载时打开数据库连接，并进行记录集初始化Private Sub Form_Load() Dim openString As String Set Cnn = CreateObject("ADODB.Connection")
Cnn.CursorLocation = adUseClient
openString = "DBQ=" & App.Path & "\PicData.MDB;"
openString = openString & "DRIVER={Microsoft Access Driver (*.mdb)}"
Cnn.Open openString
Set Rst = CreateObject("ADODB.Recordset")
Set RstView = Cnn.Execute("Select key,filename,id from pic")
Rst.CursorType = adOpenKeyset
Rst.LockType = adLockOptimistic
Rst.Open "pic", Cnn, , , adCmdTable
Set datFileDesc.DataSource = RstViewEnd Sub' 在记录集发生移动时（Datagrid被单击时）显示图片Private Sub RstView_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset) Dim buf() As Byte
Dim intFileId As Long
Dim intFileSize As Long
Dim i As Integer, j As Integer, k As Integer
Dim RstTmp As Recordset If RstView.EOF() Or RstView.BOF() Then Exit Sub Set RstTmp = Cnn.Execute("Select FileData From Pic Where ID=" & RstView("ID"))
intFileId = FreeFile()
Open App.Path & "\" & RstView("FileName") _
For Binary Access Write As #intFileId
intFileSize = RstTmp("FileData").ActualSize
Debug.Print "intFileSize = " & intFileSize
i = intFileSize \ BLOCK_SIZE
j = intFileSize Mod BLOCK_SIZE
ReDim buf(i)
Rem {{{{
For k = 1 To i
buf() = RstTmp("FileData").GetChunk(BLOCK_SIZE)
Put #intFileId, , buf()
Next
If j <> 0 Then
ReDim buf(BLOCK_SIZE)
buf() = RstTmp("FileData").GetChunk(j)
Put #intFileId, , buf()
End If
Rem }}}}
Close #intFileId
pic1.Picture = LoadPicture(App.Path & "\" & RstView("FileName"))
Kill App.Path & "\" & RstView("FileName")End Sub