>>>Where I need someones help is, I am stuck on populating the report with the related BLOB. Does anyone have or know of a walk-through on how to load BLOBs based on a related feature?
According to your description, I suggest that you could refer to the following code will extract the contents of a BLOB Field into an ADODB Stream, write the Stream to a Unique File Name in a TEMP Directory under the Current Project Directory based on a
Unique ID ([InvID]) and Extension ([sFileExtension]). These Files will then be dynamically loaded into an Image Control in a Report. Pay close attention to Code in the Click() Event of the single Command Button as well as the Format() Event of the Report's
Detail Section. Make sure to set a Reference to the Microsoft ActiveX Data Objects X.X Object Library.
Private Sub cmdTest_Click()
On Error GoTo Err_cmdTest_Click
Dim strSQL As String
Dim rstBLOB As ADODB.Recordset
Dim mstream As ADODB.stream
Dim strFullPath As String
'Create a Directory named TEMP if it doesn't exist under the Current Project Path
If Dir$(CurrentProject.Path & "\TEMP\", vbDirectory) = "" Then
MkDir CurrentProject.Path & "\TEMP\"
End If
strSQL = "SELECT tblInventoryPics.* FROM tblInventoryPics"
Set rstBLOB = New ADODB.Recordset
rstBLOB.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
If rstBLOB.RecordCount = 0 Then Exit Sub
Set mstream = New ADODB.stream
mstream.Open
With rstBLOB
Do While Not .EOF
mstream.Type = adTypeBinary
mstream.Write rstBLOB.Fields("oPicture").Value 'Write to the Stream Object
'Write BLOB to a File in the TEMP Directory under the Current Project Directory,
'with a Unique Inventory ID (InvID) and Extension (sFileExtension)
strFullPath = CurrentProject.Path & "\TEMP\" & ![InvID] & "." & ![sFileExtension]
mstream.SaveToFile strFullPath, adSaveCreateOverWrite
.MoveNext 'For each Record
Loop
End With
rstBLOB.Close
Set rstBLOB = Nothing
'Open Report
DoCmd.OpenReport "rptInventory", acViewPreview, , , acWindowNormal
DoCmd.Maximize
Exit_cmdTest_Click:
Exit Sub
Err_cmdTest_Click:
MsgBox Err.Description, vbExclamation, "Error in cmdTest_Click()"
Resume Exit_cmdTest_Click
End Sub
Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
Me![imgPicture].Picture = CurrentProject.Path & "\TEMP\" & Me![InvID] & "." & Me![sFileExtension]
End Sub
