我正在尝试通过VBA从SQLite3检索BLOB值。这些字节是使用Python从http返回中输入的。它们代表一个图像(TIF),稍后将返回给用户。首先,由于对用于执行此操作的计算机的限制,我将使用VBA / Excel来执行此操作。我已经通过Python和C#完成了此过程,以验证我提取的数据没有问题。现在,我需要将其放入VBA,以使其易于分发给用户。
在VBA中,我能够获取记录值并根据需要对其进行迭代,但是每当我获得字节值时,我的Excel Instant Window便会显示框
“ EXCEL无法响应,重新启动或调试”等。
我也做了很多不同的事情,而不仅仅是尝试将字节写到文件中。我只是尝试
Dim byt() as bytes
byt = rcdset.Fields("IMAGE_STRING").Value
也
LenB(rcdset.Fields("IMAGE_STRING").Value)
甚至只是
Debug.Print rcdset.Fields("IMAGE_STRING").Value
无论我在做什么,当我逐步浏览涉及rcdset.Fields("IMAGE_STRING").Value
的代码时,它都会停止。
当前代码/尝试:
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)
当然,一旦到达stream.Write rcdset.Fields("IMAGE_STRING").Value
并调用该值,它就会下降。我尝试以所有不同的方式访问该字段,例如rcdset.Fields("IMAGE_STRING")
,"rcdset("IMAGE_STRING")
等。
如何创建此图像文件?我去写python做一个简单的
with open(f'''P:\\{name}.{ext}''', 'wb') as of:
of.write(bytes)
,它会产生注销。 C#当然也有更多的代码,但是没有问题。这让我发疯。 VBA不能处理此类数据吗?
下面有完整的代码,感谢您的帮助!
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
下面的错误图片
我从谷歌那里得到了这张照片。无法嵌入我的图片