穷人提问：数据类型不匹配??

[badboy168]

Option Explicit
Dim Cnn As ADODB.Connection, Rs As ADODB.Recordset, Str As String

Private Sub Form_Load()
'初始化ADO，连接数据库
Set Cnn = New ADODB.Connection
Str = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Program Files\WENJIAN.mdb;Persist
Security Info=False"
Cnn.Open Str
Set Rs = New ADODB.Recordset
Rs.Open "笔记特征", Cnn, adOpenDynamic, adLockOptimistic, adCmdTable
JianCai = LoadPicture()
YangBen = LoadPicture()
End Sub

Private Sub Command1_Click()
JianCai = LoadPicture()
YangBen = LoadPicture()
Rs.AddNew
End Sub

Private Sub Command2_Click()
Rs.Fields(0) = JianCai.Picture ‘错误就出面在这2行
Rs.Fields(1) = YangBen.Piture
Rs.Update
JianCai = LoadPicture()
YangBen = LoadPicture()
End Sub


在数据库的“笔记特征”表中的2个字段是二进制型的,为何会出现“类型不匹配”的错误呢，请朋友们帮忙解决

[of123]

你的源类型有问题。它必须是byte数组或字符串。

Public Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors As RGBQUAD
End Type

' Save the picture into the database as a DIB.
Private Sub SaveDibToDb(rs As ADODB.Recordset)
Dim bytes_per_scanLine As Integer
Dim wid As Long
Dim hgt As Long
Dim bitmap_info As BITMAPINFO
Dim pixels() As Byte
Dim buffer() As Byte

' Prepare the bitmap description.
wid = picPerson.ScaleWidth
hgt = picPerson.ScaleHeight
With bitmap_info.bmiHeader
.biSize = 40
.biWidth = wid
' Use negative height to scan top-down.
.biHeight = -hgt
.biPlanes = 1
.biBitCount = 32
.biCompression = BI_RGB
bytes_per_scanLine = ((((.biWidth * .biBitCount) + _
31) \ 32) * 4)
.biSizeImage = bytes_per_scanLine * hgt
End With

' Load the bitmap's data.
ReDim pixels(1 To 4, 1 To wid, 1 To hgt)
GetDIBits picPerson.hdc, picPerson.Image, _
0, hgt, pixels(1, 1, 1), _
bitmap_info, DIB_RGB_COLORS

' Save the BITMAPINFO.
ReDim buffer(0 To Len(bitmap_info.bmiHeader) - 1)
CopyMemory buffer(0), bitmap_info.bmiHeader, _
Len(bitmap_info.bmiHeader)

rs!Picture.AppendChunk buffer

' Save the pixels.
ReDim buffer(0 To 4 * wid * hgt - 1)
CopyMemory buffer(0), pixels(1, 1, 1), 4 * wid * hgt
rs!Picture.AppendChunk buffer
End Sub

' Load the DIB from the database.
Private Sub LoadDibFromDb(rs As ADODB.Recordset)
Dim bytes_per_scanLine As Integer
Dim wid As Long
Dim hgt As Long
Dim bitmap_info As BITMAPINFO
Dim pixels() As Byte
Dim buffer() As Byte

' Get the BITMAPINFO.
buffer = rs!Picture.GetChunk(Len(bitmap_info.bmiHeader))
CopyMemory bitmap_info.bmiHeader, buffer(0), _
Len(bitmap_info.bmiHeader)

' Get the pixels.
wid = bitmap_info.bmiHeader.biWidth
hgt = Abs(bitmap_info.bmiHeader.biHeight)
buffer = rs!Picture.GetChunk(4 * wid * hgt)

ReDim pixels(1 To 4, 1 To wid, 1 To hgt)
CopyMemory pixels(1, 1, 1), buffer(0), 4 * wid * hgt

' Size the PictureBox.
picPerson.Move picPerson.Left, picPerson.Top, wid, hgt

' Display the results.
SetDIBits picPerson.hdc, picPerson.Image, _
0, hgt, pixels(1, 1, 1), _
bitmap_info, DIB_RGB_COLORS
picPerson.Picture = picPerson.Image
End Sub

[badboy168]

我的2个字段都是Binary型的，这种类型的字段是可以存储图片的吧~!~!

[of123]

Rs.Fields(0).AppendChunk JianCai.Picture
Rs.Fields(1)).AppendChunk YangBen.Piture

读取时
Set variable = recordset!field.GetChunk(offset, numbytes)

[badboy168]

Rs.Fields(0).AppendChunk JianCai.Picture
Rs.Fields(1)).AppendChunk YangBen.Piture 还有是错误
“实时错误 '3001' 参数类型不正确，可不在可以接受的范围之内，或与其它参数冲突”

[badboy168]

Rs.Fields(0).AppendChunk JianCai.Picture
Rs.Fields(1).AppendChunk YangBen.Picture
以上这两句还是有错误

[RUKYO]

MSDN：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

Const conChunkSize = 100

' 打开连接
Set cnn1 = New ADODB.Connection
strCnn = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Password=;Initial Catalog=pubs;Data Source=Server"
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

[helanshan]

up