How can I upload a file to an Oracle BLOB field using VB6? - oracle

Question

I want to take a file from disk and upload it into an Oracle BLOB field, using VB6. How can I do that?

Answer 1

Answering my own question, for reference:
Public Function SaveFileAsBlob(fullFileName As String, documentDescription As String) As Boolean
'Upload a binary file into the database as a BLOB
'Based on this example: http://www.codeguru.com/forum/printthread.php?t=337027
Dim rstUpload As ADODB.Recordset
Dim pkValue AS Long
On Error GoTo ErrorHandler
Screen.MousePointer = vbHourglass
'Create a new record (but leave document blank- we will update the doc in a moment)
'the where clause ensures *no* result set; we only want the structure
strSQL = "SELECT DOC_NUMBER, DOC_DESC, BLOB_FIELD " & _
" FROM MY_TABLE " & _
" WHERE PRIMARY_KEY = 0"
pkValue = GetNextPKValue
Set rstUpload = New ADODB.Recordset
With rstUpload
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
.Open strSQL, myConn
.AddNew Array("DOC_NUMBER", "DOC_DESC"), _
Array(pkValue, documentDescription)
.Close
End With
'They may have the document open in an external application. Create a copy and work with that copy
Dim tmpFileName As String
tmpFileName = GetTempPath & ExtractFileName(fullFileName)
'if the tmp file exists, delete it
If Len(Dir(tmpFileName)) > 0 Then
Kill tmpFileName
End If
'see this URL for info about this subroutine:
'http://stackoverflow.com/questions/848087/how-can-i-copy-an-open-file-using-vb6
CopyFileEvenIfOpen fullFileName, tmpFileName
'Now that our record is inserted, update it with the file from disk
Set rstUpload = Nothing
Set rstUpload = New ADODB.Recordset
Dim st As ADODB.Stream
rstUpload.Open "SELECT BLOB_FIELD FROM MY_TABLE WHERE PRIMARY_KEY = " & pkValue
, myConn, adOpenDynamic, adLockOptimistic
Set st = New ADODB.Stream
st.Type = adTypeBinary
st.Open
st.LoadFromFile (tmpFileName)
rstUpload.Fields("BLOB_FIELD").Value = st.Read
rstUpload.Update
'Now delete the temp file we created
Kill (tmpFileName)
DocAdd = True
ExitPoint:
On Error Resume Next
rstUpload.Close
st.Close
Set rstUpload = Nothing
Set st = Nothing
Screen.MousePointer = vbDefault
Exit Function
ErrorHandler:
DocAdd = False
Screen.MousePointer = vbDefault
MsgBox "Source: " & Err.Source & vbCrLf & "Number: " & Err.Number & vbCrLf & Err.Description, vbCritical, _
"DocAdd Error"
Resume ExitPoint
End Function