472,146 Members | 1,379 Online
Bytes | Software Development & Data Engineering Community
Post +

Home Posts Topics Members FAQ

Join Bytes to post your question to a community of 472,146 software developers and data experts.

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

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
1 1705
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.

Similar topics

1 post views Thread by phpmaet | last post: by
reply views Thread by Saiars | last post: by
reply views Thread by leo001 | last post: by

By using Bytes.com and it's services, you agree to our Privacy Policy and Terms of Use.

To disable or enable advertisements and analytics tracking please visit the manage ads & tracking page.