VBA从sqlite读取字节到文件

时间:2019-02-05 18:17:57

标签: excel vba sqlite blob adodb

我正在尝试通过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

下面的错误图片

https://www.google.com/imgres?imgurl=https%3A%2F%2Fwww.stellarinfo.com%2Fblog%2Fwp-content%2Fuploads%2F2017%2F02%2FExcel-not-responding.png&imgrefurl=https%3A%2F%2Fwww.stellarinfo.com%2Fblog%2Ffix-microsoft-excel-is-not-responding-error%2F&docid=XoYYxJE6mc5PtM&tbnid=coD0C_Y_q1La5M%3A&vet=10ahUKEwiM-_2Yx6fgAhUptIMKHepGDLYQMwhBKAEwAQ..i&w=363&h=266&client=firefox-b-1-d&bih=944&biw=1920&q=excel%20not%20responding%20error&ved=0ahUKEwiM-_2Yx6fgAhUptIMKHepGDLYQMwhBKAEwAQ&iact=mrc&uact=8

我从谷歌那里得到了这张照片。无法嵌入我的图片

0 个答案:

没有答案