Access 2007，VBA：将 BLOB 插入链接表时出现奇怪的错误

Question

尝试将二进制文件插入 varbinary 列时，我遇到了一个奇怪的错误。架构如下：

具有此表对象的 SQL Server 2008 数据库：

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

该表链接到一个 MS Access 2007 应用程序，作为表 BLOBs 包含这个“quick'n dirty”书面模块：

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

顺便说一句：ODBC 驱动程序是 SQL Server 版本 6.01.7601.17514 (SQLSRV32.DLL, 21.11.2010)。

只要我通过即时窗口调用该函数，一切都很好：

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

blob 数据已成功保存。现在有一个表单中的这个小子：

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

如果从这里调用saveBLOB()，则会发生错误（您试图将 Null 值分配给不是 Variant 数据类型的变量。）：

更新：这似乎是一个大小问题。插入了一个新创建的 8KB 的 Excel 文件。导入 681KB 的文件失败。 Blob 列是varbinary(max)。根据 docs.microsoft.com：

ma​​x 表示最大存储大小为 2^31-1 字节。 所以 681KB 应该非常适合。

非常感谢您！

Answer 1

有一个最大数据大小，您可以在一个语句中添加/编辑。见Configure the max text repl size Server Configuration Option。

为了规避使用.AppendChunk。

rs!FileBLOB.AppendChunk blob

对于像在 sql server 上的操作，我更喜欢Adodb，因为 OleDb 驱动程序提供在服务器上直接执行 sql，Adodb.Stream 简化了二进制读/写。

使用 ADODB 的保存BLOB 函数（后期绑定）：

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