I am attempting to retrieve a BLOB value from SQLite3 through VBA. The bytes were entered from a http return using Python. They represent an image(TIF) that will later be returned to the user. I will start by saying that, due to restrictions on the computers being used to perform this action, I will be using VBA/Excel to do so. I have already completed this process through Python and C# to verify there is nothing wrong with the data I am pulling out. Now I need to get it in to VBA to make it easily distributable to the users.
In VBA I am able to get the record values out and iterate over them as needed, but whenever i get to the byte value my Excel Immediate Window gives me the box that says
"EXCEL NOT RESPONDING, RESTART OR DEBUG" etc.
I have done many different things too, not just try to write the bytes to a file. I have tried simply
Dim byt() as bytes
byt = rcdset.Fields("IMAGE_STRING").Value
Also
LenB(rcdset.Fields("IMAGE_STRING").Value)
and even just
Debug.Print rcdset.Fields("IMAGE_STRING").Value
No matter what I am doing, when I step through the code that touches rcdset.Fields("IMAGE_STRING").Value it stops.
Current code/attempt:
Dim stream As New ADODB.stream
OutFile = "P:\Testie.TIF"
stream.Type = adTypeBinary
stream.Open
stream.Write rcdset.Fields("IMAGE_STRING").Value
stream.SaveToFile (OutFile)
And of course, as soon as it gets to stream.Write rcdset.Fields("IMAGE_STRING").Value and calls that value it goes down. I have tried accessing the field all different ways such as rcdset.Fields("IMAGE_STRING"), "rcdset("IMAGE_STRING"), etc.
How can I create this image file? I go write over to python and do a simple
with open(f'''P:\\{name}.{ext}''', 'wb') as of:
of.write(bytes)
and it creates write away. C# same with of course a little more code but no problem. This is driving me NUTS. Can VBA not handle this kind of data?
Full code below and any help is appreciated!
Dim file As New Scripting.FileSystemObject
Dim conn As New ADODB.Connection
Dim rcdset As New ADODB.Recordset
Dim stream As New ADODB.stream
'Dim rec As New ADODB.Field
Dim filepath As String
Dim bytes As Byte
Dim connStr As String
Dim sql As String
Dim lastrow As Integer
Dim ScacRange As Range
Dim RowCounter As Integer
Dim Pro As String
Dim Carrier As String
Dim PaperType As String
Dim downloaded() As String
Dim i As Integer
Dim paperTitle As String
Dim fileLen As Long
Dim OutFile As String
Dim binlength As Long
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
If lastrow > 501 Then
MsgBox "You can only process 500 at one time.", vbInformation
Exit Sub
End If
Set ScacRange = Range(Cells(2, 2), Cells(lastrow, 2))
filepath = Cells(1, 5).Value
RowCounter = 2
For Each Scac In ScacRange
If Len(Trim(Scac.Value)) <> 4 Then
MsgBox "Row " & CStr(RowCounter) & " does not contain a 4 letter Scac. Please correct and try again."
Exit Sub
End If
RowCounter = RowCounter + 1
Next Scac
If Not file.FolderExists(filepath) Then
MsgBox "The folder '" & filepath & "' does not exist. Please enter a valid folder.", vbExclamation, "File Path Error"
Exit Sub
End If
connStr = "DRIVER=SQLite3 ODBC Driver;Database=Z:\IMAGE.db"
On Error GoTo Cleanup
conn.Open connStr
For Each Scac In ScacRange
If IsEmpty(Scac) Or IsEmpty(Scac.Offset(0, -1)) Or IsEmpty(Scac.Offset(0, 1)) Then
Scac.Offset(0, 2).Value = "Not all values present. No image retreived"
GoTo NextIter
End If
Pro = Trim(Scac.Offset(0, -1).Value)
Carrier = Trim(UCase(Scac.Value))
PaperType = Scac.Offset(0, 1).Value
If PaperType = "BOTH" Then
sql = "SELECT IMAGE_ID, IMAGE_STRING, IMAGE_FILE_EXT FROM DOCUMENTS WHERE PRO_NUMBER = '" & Pro & "' AND SCAC = '" & Carrier & "' AND IMAGE_TYPE IN('BL','DR')"
rcdset.Open sql, conn
If rcdset.BOF And rcdset.EOF Then
Scac.Offset(0, 2).Value = "No Images available"
rcdset.Close
GoTo NextIter
End If
rcdset.MoveFirst
i = 0
Do Until rcdset.EOF
paperTitle = rcdset.Fields(0).Value
ReDim Preserve downloaded(i)
downloaded(i) = paperTitle
OutFile = "P:\Testie.TIF"
stream.Type = adTypeBinary
stream.Open
''''''''''''The below line is where it breaks down''''''''''''''''''''''''''''
stream.Write rcdset.Fields("IMAGE_STRING").Value
stream.SaveToFile OutFile, adSaveCreateOverWrite
'do work
i = i + 1
Debug.Print paperTitle
rcdset.MoveNext
Loop
rcdset.Close
Scac.Offset(0, 2).Value = Join(downloaded, ", ") & " downloaded to folder."
ReDim downloaded(0)
Else:
sql = "SELECT IMAGE_ID, IMAGE_STRING FROM DOCUMENTS WHERE PRO_NUMBER = '" & Pro & "' AND SCAC = '" & Carrier & "' AND IMAGE_TYPE = '" & PaperType & "'"
rcdset.Open sql, conn
If rcdset.BOF And rcdset.EOF Then
Scac.Offset(0, 2).Value = "No Images available"
rcdset.Close
GoTo NextIter
End If
rcdset.MoveFirst
Debug.Print rcdset.Fields(0).Value
'dow work
Scac.Offset(0, 2).Value = "Downloaded to folder"
rcdset.Close
End If
NextIter:
Next Scac
Cleanup:
If IsObject(rcdset) Then
If rcdset.State = 1 Then
rcdset.Close
End If
Set rcdset = Nothing
End If
If IsObject(conn) Then
If conn.State = 1 Then
conn.Close
End If
Set conn = Nothing
End If
If IsObject(file) Then
Set file = Nothing
End If
Error picture below
I got this picture from google. Couldnt get my image embedded
