Retrieve File Extension for Embedded OLE Object

Dim strSQL As String
Dim rstBLOB As ADODB.Recordset
Dim mstream As ADODB.Stream
Dim strFullPath As String
Const conTEMP_FOLDER As String = "C:\TEMP\"
 
'Return a 'Unique, Single Record via the Primary Key ([InvID])
strSQL = "SELECT tblInventoryPics.* FROM tblInventoryPics"
strSQL = strSQL & " WHERE tblInventoryPics.InvID=" & Me![InvID]
  
'Open an ADO Recordset
Set rstBLOB = New ADODB.Recordset
rstBLOB.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
 
If rstBLOB.RecordCount = 0 Then Exit Sub
rstBLOB.MoveFirst
 
'Create a Stream Object to contain the Binary Data from the OLE Object Field,
'(adTypeBinary), then Open it
Set mstream = New ADODB.Stream
mstream.Type = adTypeBinary
mstream.Open
 
'Write the contents of the OLE Object Field to the Stream
mstream.Write rstBLOB.Fields("oPicture").Value
 
'Save the Stream to a Unique Filename, represented by a combination of the Date,
'Time, and a File Extension as stored in the Table long with the OLE Object.
mstream.SaveToFile conTEMP_FOLDER & Format(Now(), "mmddyyyy_hhnnss.") & _
                   rstBLOB.Fields("sFileExtension").Value, adSaveCreateOverWrite
 
'Close the BLOB and set to Nothing before it devours you (LOL)!
rstBLOB.Close
Set rstBLOB = Nothing