By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
464,325 Members | 1,147 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 464,325 IT Pros & Developers. It's quick & easy.

Two saved image files to BLOB (BLOB to current record, not next record)?

P: 4
Hi,

Hope you can assist...

My table has two OLE/BLOB fields. 1 x OLE (Photo) and 1 x OLE (Signature).

1. With WebCam, I save my image - "Works Fine":

Private Sub Capture_Click()
ezVidCap1.SaveDIB "C:\VisitorPhoto.jpg"
DoCmd.Close
DoCmd.OpenForm "frmImageBLOBDataEntry", , , , acFormAdd
End Sub

1.1 I the use the following code for FileToBLOB (WebCam Image) - "Works Fine":

Private Sub cmdSave_Click()
On Error GoTo Err_cmdSave_Click
Dim vntRetVar As Variant
Dim db As Database
Dim rs As Recordset
Set db = CurrentDb()
Set rs = db.OpenRecordset("tblImageBLOBs")
If Validate Then
vntRetVar = ReadBLOB(Me![imgTheImage].Picture, rs, "ImageItem")
If vntRetVar <= 0 Then GoTo SpecialError
rs.MoveLast
rs.Edit
rs("visFirstName") = Me![visFirstName]
rs("visSurname") = Me![visSurname]
rs("ImageFileExtension") = Right(Me![imgTheImage].Picture, 3)
rs.Update
On Error Resume Next
DoCmd.Echo False
Forms![frmImageBLOBSummaryList].Requery
DoCmd.Echo True
DoCmd.Close acForm, Me.Name
DoCmd.GoToRecord , , acLast
End If
Exit_cmdSave_Click:
On Error Resume Next
rs.Close
Set rs = Nothing
Set db = Nothing
Exit Sub
Err_cmdSave_Click:
MsgBox "Err: " & Err.Number & " : " & Err.Description & " in Sub cmdSave_Click", vbCritical, "Protocol Validation Error"
Resume Exit_cmdSave_Click
SpecialError:
MsgBox "Error " & -vntRetVar & " trying to write the BLOB", vbCritical, "Protocol Validation Error"
Resume Exit_cmdSave_Click
End Sub

2. With Graphics Tablet, I save my signature - "Works Fine":

Dim objInk As MSINKAUTLib.InkPicture
Dim bytArr() As Byte
Dim File1 As String
File1 = "C:\VisitorSignature.jpg"
Set objInk = Me.InkPicture1.Object
If objInk.Ink.Strokes.Count > 0 Then
bytArr = objInk.Ink.Save(2)
Open File1 For Binary As #1
Put #1, , bytArr
Close #1
End If
DoCmd.Close
DoCmd.OpenForm "frmImageBLOBDataEntryVis", , , , acFormAdd
End Sub

2.1 Here is my question/problem!?! The code above (1.1) BLOBs my image. I need to do the same with the signature but it keeps adding the signature to the "next record" and not the "current record". I know the code below is incorrect but I have no clue how to correct it. Here is what I have - "Disaster":

Private Sub cmdSave_Click()
On Error GoTo Err_cmdSave_Click
Dim vntRetVar As Variant
Dim db As Database
Dim rs As Recordset
Set db = CurrentDb()
Set rs = db.OpenRecordset("tblImageBLOBs")
If Validate Then
vntRetVar = ReadBLOB(Me![imgTheImage].Picture, rs, "visSignature")
If vntRetVar <= 0 Then GoTo SpecialError
rs.MoveLast
rs.Edit
rs("visFirstName") = Me![visFirstName]
rs("visSurname") = Me![visSurname]
rs("ImageFileExtensionVis") = Right(Me![imgTheImage].Picture, 3)
rs.Update
On Error Resume Next
DoCmd.Echo False
Forms![frmImageBLOBSummaryList].Requery
DoCmd.Echo True
DoCmd.Close acForm, Me.Name
DoCmd.GoToRecord , , acLast
End If
Exit_cmdSave_Click:
On Error Resume Next
rs.Close
Set rs = Nothing
Set db = Nothing
Exit Sub
Err_cmdSave_Click:
MsgBox "Err: " & Err.Number & " : " & Err.Description & " in Sub cmdSave_Click", vbCritical, "Protocol Validation Error"
Resume Exit_cmdSave_Click
SpecialError:
MsgBox "Error " & -vntRetVar & " trying to write the BLOB", vbCritical, "Protocol Validation Error"
Resume Exit_cmdSave_Click
End Sub

Any assistance appreciated...
Sep 13 '10 #1
Share this Question
Share on Google+
1 Reply

P: 4
Hi All,

Concerning my earlier post (Point 2.1)...

I have realised that my basBLOB is the problem and not cmdSave_Click()!?!

I need to BLOB three(3) fields in same record (T.Edit). Then, move to T.AddNew?

Any help is apprecited :o)

My code:
Function ReadBLOB(Source As String, T As Recordset, sField As String)

Dim NumBlocks As Integer, SourceFile As Integer, i As Integer
Dim FileLength As Long, LeftOver As Long
Dim FileData As String
Dim RetVal As Variant

SourceFile = FreeFile
Open Source For Binary Access Read As SourceFile
FileLength = LOF(SourceFile)

If FileLength = 0 Then
ReadBLOB = 0
Exit Function
End If

NumBlocks = FileLength \ BlockSize
LeftOver = FileLength Mod BlockSize

RetVal = SysCmd(acSysCmdInitMeter, "Reading BLOB", FileLength \ 1000)

If IsNull([Forms]![frmImageBLOBSummaryList]![ImageItem]) _
Or IsNull([Forms]![frmImageBLOBSummaryList]![visSignature]) _
Or IsNull([Forms]![frmImageBLOBSummaryList]![escSignature]) Then
T.Edit
Else
If Not IsNull([Forms]![frmImageBLOBSummaryList]![ImageItem]) _
Or Not IsNull([Forms]![frmImageBLOBSummaryList]![visSignature]) _
Or Not IsNull([Forms]![frmImageBLOBSummaryList]![escSignature]) Then
T.AddNew
End If
End If


FileData = String$(LeftOver, 32)
Get SourceFile, , FileData
T(sField).AppendChunk (FileData)

RetVal = SysCmd(acSysCmdUpdateMeter, LeftOver / 1000)

FileData = String$(BlockSize, 32)
For i = 1 To NumBlocks
Get SourceFile, , FileData
T(sField).AppendChunk (FileData)

RetVal = SysCmd(acSysCmdUpdateMeter, BlockSize * i / 1000)

Next i
T.Update

RetVal = SysCmd(acSysCmdRemoveMeter)

Close SourceFile
ReadBLOB = FileLength
Exit Function

Err_ReadBLOB:
ReadBLOB = -Err
MsgBox "ReadBLOB Error " & Err & " : " & Error$
Exit Function

End Function
Sep 15 '10 #2

Post your reply

Sign in to post your reply or Sign up for a free account.