0
votes

I have a strange error when trying to insert binary into a varbinary column. Architecture is as follows:

SQL Server 2008 database with this table object:

CREATE TABLE [dbo].[BLOBs] (
    [FileName] nvarchar(128) NOT NULL
    , [FileExt] AS  CASE
                        WHEN CHARINDEX(N'.', [FileName]) > 0 THEN REVERSE(SUBSTRING(REVERSE([FileName]), 1, CHARINDEX('.', REVERSE([FileName])) - 1))
                        ELSE NULL
                    END PERSISTED
    , [FileBLOB] [varbinary](max) NOT NULL
    , CONSTRAINT [PK_BLOBs] PRIMARY KEY CLUSTERED ( [FileName] ASC ) ON [DEFAULT]
) ON [DEFAULT];
GO

This table is linked to a MS Access 2007 Application as table BLOBs containing this "quick'n dirty" written module:

Public Function saveBLOB(strFQFN As String) As Long
10      If HandleErrors() Then On Error GoTo ERR_HANDLING
20      ErrorHandler().CallStack.PushCallStack "saveBLOB('" & strFQFN & "')"

        Dim db  As DAO.Database
        Dim rs  As DAO.Recordset
        Dim fs  As Long
        Dim fn  As String
        Dim hdl As Integer
        Dim blob()  As Byte

30      fn = Right(strFQFN, Len(strFQFN) - InStrRev(strFQFN, "\"))

        ' read data from file
40      hdl = FreeFile()
50      Open strFQFN For Binary Access Read As #hdl
60      fs = LOF(hdl) - 1
70      ReDim blob(fs)
90      Get #hdl, , blob

        ' updateblob data in database
100     Set db = CurrentDb()
110     Set rs = db.OpenRecordset("BLOBs", dbOpenDynaset, dbSeeChanges)
120     rs.FindFirst ("[FileName] = '" & fn & "'")
130     If rs.NoMatch Then
140         rs.AddNew
150         rs!FileName = fn
160     Else
170         rs.Edit
180     End If

190     rs!FileBLOB = blob
200     rs.Update

210     saveBLOB = True

CLEANUP:
8000    Close #hdl
8010    On Error Resume Next
8020    rs.close
8030    Set rs = Nothing
8040    Set db = Nothing
8050    Erase blob

FINALLY:
9000    On Error GoTo 0
9010    ErrorHandler().CallStack.PopCallStack
9020    Exit Function

ERR_HANDLING:
9900    ErrorHandler().handleError ErrSinkScreen, "saveBLOB()"
9910    saveBLOB = False
9920    Resume CLEANUP
End Function

By the way: ODBC driver is SQL Server Version 6.01.7601.17514 (SQLSRV32.DLL, 21.11.2010).

Everythings works fine as long as I call the function via the immediate windows:

? saveBLOB("U:\example.txt")
-1

The blob data is successfully saved. Now there is this little sub in a form:

Private Sub UploadFile()
10      If HandleErrors() Then On Error GoTo ERR_HANDLING
20      ErrorHandler().CallStack.PushCallStack Me.Name & ".UploadFile()"

30      If (Not saveBLOB(Nz(Me!txtFQFN, vbNullString))) Then _
            MsgBox "Beim Speichern des BLOBs in der Datenbank ist ein Fehler aufgetreten.", vbExclamation

FINALLY:
9000    ErrorHandler().CallStack.PopCallStack
9010    Exit Sub

ERR_HANDLING:
9900    ErrorHandler().handleError ErrSinkDatabase + ErrSinkScreen, Me.Name & ".UploadFile()"
9910    Resume FINALLY
End Sub

If saveBLOB() is called from here an error occurs (You tried to assign the Null value to a variable that is not a Variant data type.):

Error 3162

UPDATE: It seems to be a question of size. Insert of a newly created Excel file with 8KB worked. Import of a file with 681KB failed. Blob column is varbinary(max). According to docs.microsoft.com:

max indicates that the maximum storage size is 2^31-1 bytes. So 681KB should fit perfectly in.

Thank you very much in advance!

1
Strange error handling. Where is its source? Skip numbered code lines as unnecessary github.com/rubberduck-vba/Rubberduck/issues/… - ComputerVersteher
There is no integrated debugger in VBA. Error stacks etc. have to be implemented. I totally agree with you that the code needs (a lot of) improvements. But the application is now over 20 years old ... - D.C.
Someone has stolen your debugger;( Code doesn't look too bad (besides missing query parameter and two bangs, assuming Option Explict used). For pro errorhandling in vba try vbwatchdog. - ComputerVersteher

1 Answers

0
votes

There is a max size of data,you can add/edit in one statement. See Configure the max text repl size Server Configuration Option.

To circumvent use .AppendChunk.

rs!FileBLOB.AppendChunk blob

For operations like that on a sql server, I would preferAdodb, as OleDb driver provides direct sql execution on server and Adodb.Stream simplifies binary read/write.

saveBLOB function using ADODB (late-bound):

Public Function saveBLOB(strFQFN As String) As Long

With CreateObject("Scripting.FileSystemObject")  
    Dim fn as String
    fn = .GetFileName(.GetFile(strFQFN))
End With

Dim cnn As Object
Set cnn = CreateObject("ADODB.Connection")
With cnn
    Dim ConString As String
    'uses msoledbsql_18.3 as povider
    ConString = "Provider=MSOLEDBSQL;Data Source=server\instance;Integrated Security=SSPI;Persist Security Info=False;Trusted_Connection=yes;Initial Catalog=db;"
    .Mode = 3 'adModeReadWrite
    .CursorLocation = 3 'adUseClient
    .Open ConString
End With

Dim cmd As Object
Set cmd = CreateObject("ADODB.Command")
With cmd
    .ActiveConnection = cnn
    .CommandText = "SELECT Filename, FileBLOB FROM blob WHERE FiLENAME = ?"
    .Parameters.Append .CreateParameter("FilterFilename", 200, 1, 200, fn)
    
    With CreateObject("ADODB.Recordset")
        .LockType = 3 'adLockOptimistic
        .Open cmd, , 3 'adOpenDynamic
        
        
            Set Stream = CreateObject("ADODB.Stream")
            Stream.Type = 1
            Stream.Open
            Stream.LoadFromFile strFQFN
            If .EOF Then
                .AddNew
                .Fields("Filename") = fn
            End If
            Const ChunkSize As Long = 16384 '16K chunk size, you may vary (bigger is faster)
            Do While Stream.Position < Stream.Size
                .Fields("FileBLOB").AppendChunk Stream.Read(ChunkSize)
            Loop
            .Update
        End If
    End With
End With

saveBLOB = True

Set cmd = Nothing
Set Stream = Nothing
cnn.Close
Set cnn = Nothing
End Function