多重步驟操作發生錯誤。請檢查每一個狀態值!什麼意思？

Question

'修改blobPrivate Sub Edit_Click()
     FileToBlob "C:\regtemplate.fpt", Adodc1.Recordset.Fields(6)
End SubSub FileToBlob(ByVal FName As String, fld As ADODB.Field, _
                     Optional Threshold As Long = 1048576)
      '
      ' Assumes file exists
      ' Assumes calling routine does the UPDATE
      ' File cannot exceed approx. 2Gb in size
      '
      Dim F As Long, Data() As Byte, FileSize As Long
        F = FreeFile
        Open FName For Binary As #F
        FileSize = LOF(F)
        Select Case fld.Type
          Case adLongVarBinary
            If FileSize > Threshold Then
              ReadToBinary F, fld, FileSize
            Else
              Data = InputB(FileSize, F)
              fld.Value = Data
            End If
          Case adLongVarChar, adLongVarWChar
            If FileSize > Threshold Then
              ReadToText F, fld, FileSize
            Else
              fld.Value = Input(FileSize, F)
            End If
        End Select
        Close #F
      End Sub      Sub ReadToBinary(ByVal F As Long, fld As ADODB.Field, _
                       ByVal FileSize As Long)
      Dim Data() As Byte, BytesRead As Long
        Do While FileSize <> BytesRead
          If FileSize - BytesRead < BLOCK_SIZE Then
            Data = InputB(FileSize - BytesRead, F)
            BytesRead = FileSize
          Else
            Data = InputB(BLOCK_SIZE, F)
            BytesRead = BytesRead + BLOCK_SIZE
          End If
          fld.AppendChunk Data
        Loop
      End Sub      Sub ReadToText(ByVal F As Long, fld As ADODB.Field, _
                     ByVal FileSize As Long)
      Dim Data As String, CharsRead As Long
        Do While FileSize <> CharsRead
          If FileSize - CharsRead < BLOCK_SIZE Then
            Data = Input(FileSize - CharsRead, F)
            CharsRead = FileSize
          Else
            Data = Input(BLOCK_SIZE, F)
            CharsRead = CharsRead + BLOCK_SIZE
          End If
          fld.AppendChunk Data
        Loop
      End Sub

Answer 1

   下面函数主要实现把WORD报表文件添加到数据库中，与你的代码有点类似，仅供参靠。
Public Function write_rpt(rptFile, rpttitle, rptsql As String) As String
    Dim byteData() As Byte
    Dim LeftOver, FileLength As Long
    Dim SourceFileNum, NumBlocks, i, j As Integer
    Dim cnn1 As ADODB.Connection
    Dim rst1 As ADODB.Recordset
    Dim col, colsql As ADODB.Field
    write_rpt = CStr(j)
    Set cnn1 = New ADODB.Connection
    Call cnn1.Open(connectstr())
    Set rst1 = New ADODB.Recordset
    rst1.ActiveConnection = cnn1
    On Error GoTo errorhandle
    Call rst1.Open("select max(serial) from rpt", cnn1, adOpenKeyset, adLockReadOnly)
    If rst1.RecordCount >= 1 Then
       i = rst1.Fields(0).value + 1
    Else
       i = 1
    End If
    j = i
    rst1.Close
    Call rst1.Open("select * from rpt", cnn1, adOpenDynamic, adLockOptimistic)
    Call rst1.addnew
    rst1.Fields("serial").value = i
    rst1.Fields("rpt_title").value = rpttitle
    rst1.Fields("sql").value = rptsql
    
     Set col = rst1.Fields("rpt_file")
    SourceFileNum = FreeFile
    Open (rptFile) For Binary As SourceFileNum
    FileLength = LOF(SourceFileNum)
    If FileLength > 50 Then
        NumBlocks = FileLength \ 8192
        LeftOver = FileLength Mod 8192
        ReDim byteData(LeftOver)
        Get SourceFileNum, , byteData()
        col.AppendChunk byteData()
        ReDim byteData(8192)
        For i = 1 To NumBlocks
            Get SourceFileNum, , byteData()
            col.AppendChunk byteData()
       Next
    End If
    rst1.Update
    Close SourceFileNum
    Set rst1 = Nothing
    cnn1.Close
    Set cnn1 = Nothing
    write_rpt = CStr(j)
    MsgBox "已成功添加报表: " + rpttitle, vbOKOnly, "信息"
    Exit Function
errorhandle:
      MsgBox Err.Description & "   错误号：" & Err.Number, vbOKOnly, "出错信息"
      Set rst1 = Nothing
      cnn1.Close
      Set cnn1 = Nothing
      Exit Function
End Function