VBA читает байты из sqlite в файл - PullRequest
Новая
       12

VBA читает байты из sqlite в файл

0 голосов
/ 05 февраля 2019

Я пытаюсь получить значение BLOB из SQLite3 через VBA.Байты были введены из HTTP-возврата с использованием Python.Они представляют изображение (TIF), которое впоследствии будет возвращено пользователю.Я начну с того, что из-за ограничений на компьютеры, используемые для выполнения этого действия, я буду использовать VBA / Excel для этого.Я уже завершил этот процесс через Python и C #, чтобы убедиться, что с данными, которые я извлекаю, все в порядке.Теперь мне нужно передать его в VBA, чтобы его было легко распространять среди пользователей.

В VBA я могу вывести значения записей и перебирать их по мере необходимости, но всякий раз, когда добираюсь до значения байтамое окно немедленного доступа к 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

Я получил эту фотографию от Google.Не удалось вставить мое изображение

...