How To Retrieve and Update a SQL Server Text Field Using ADO (180368)

MORE INFORMATION

Step by Step Sample Project

1. Open a new project. Form1 is created by default.
2. From the Project menu, click References, and set a reference to the Microsoft ActiveX Data Objects Library.
3. Add a new standard module to your project, and paste the following code:

      Global cn As ADODB.Connection
      Global cmd1 As ADODB.Command
      Global rsset As ADODB.Recordset
   
      Const BLOCKSIZE As Long = 4096
   
      Public Sub ColumnToFile(Col As ADODB.Field, DiskFile As String)
       'Retrieves data from the database and puts it into a temp file on
       'the hard drive.
       'The size of the chunk is in the variable BLOCKSIZE (4096).
   
      Dim NumBlocks As Long  'Holds the number of chunks.
      Dim LeftOver As Long   '# of chars left over after last whole chunk.
      Dim strData As String
      Dim DestFileNum As Long
      Dim I As Long
      Dim ColSize As Long
   
      'Make sure that you aren't in an empty recordset.
       If Not rsset.EOF And Not rsset.BOF Then
       ColSize = Col.ActualSize
   
      'If filelength > 0, then it is soiled:
      ' throw away contents.
       If Len(Dir$(DiskFile)) > 0 Then
         Kill DiskFile
       End If
   
       DestFileNum = FreeFile
       Open DiskFile For Binary As DestFileNum
       NumBlocks = ColSize \ BLOCKSIZE
       LeftOver = ColSize Mod BLOCKSIZE
   
       'Now Write data to the file in chunks.
        For I = 1 To NumBlocks
        strData = String(BLOCKSIZE, 0)
        strData = Col.GetChunk(BLOCKSIZE)
        Put DestFileNum, , strData
        Next I
        strData = String(LeftOver, 0)
        strData = Col.GetChunk(LeftOver)
        Put DestFileNum, , strData
   
        Close DestFileNum
        End If
         End Sub
   
        Sub FileToColumn(Col As ADODB.Field, DiskFile As String)
        'Takes data from the temp file and saves it to the database.
   
          Dim strData As String
          Dim NumBlocks As Long
          Dim FileLength As Long
          Dim LeftOver As Long
          Dim SourceFile As Long
          Dim I As Long
   
          SourceFile = FreeFile
          Open DiskFile For Binary Access Read As SourceFile
          FileLength = LOF(SourceFile)
          If FileLength = 0 Then
           Close SourceFile
           MsgBox DiskFile & " Empty or Not Found."
          Else
           NumBlocks = FileLength \ BLOCKSIZE
           LeftOver = FileLength Mod BLOCKSIZE
           Col.AppendChunk Null
           strData = String(BLOCKSIZE, 0)
           For I = 1 To NumBlocks
            Get SourceFile, , strData
            Col.AppendChunk strData
           Next I
           strData = String(LeftOver, 0)
           Get SourceFile, , strData
           Col.AppendChunk strData
           rsset.Update
           Close SourceFile
          End If
         End Sub
   
         Public Sub FileToForm(DiskFile As String, SomeControl As Control)
          'Retrieves data from the temp file and puts it onto the control.
   
          Dim SourceFile As Long
          Dim FileLength As Long
          Dim strData As String
   
          SourceFile = FreeFile
          Open DiskFile For Binary Access Read As SourceFile
          FileLength = LOF(SourceFile)
          If FileLength = 0 Then
           Close SourceFile
           MsgBox DiskFile & " Empty or Not Found."
          Else
           strData = String(FileLength, 0)
           Get SourceFile, , strData
           SomeControl.Text = strData
           Close SourceFile
          End If
         End Sub
   
         Sub FormToFile(DiskFile As String, SomeControl As Control)
          'Saves data from the form into a temp file on the local hard drive.
   
          Dim DestinationFile As Long
          Dim FileLength As Long
          Dim strData As String
   
          If Len(Dir$(DiskFile)) > 0 Then
           Kill DiskFile
          End If
          DestinationFile = FreeFile
          Open DiskFile For Binary As DestinationFile
          strData = SomeControl.Text
          Put DestinationFile, , strData
          Close DestinationFile
         End Sub

4. Using the default Form1:
   1. Add a RichTextBox control, and set its Name property to "rtbText."
   2. Add a CommandButton control, and set its Name property to "cmdPrev" and the Caption property to "Prev."
   3. Add a CommandButton control, and set its Name property to "cmdNext" and the Caption property to "Next."
   4. Add a CommandButton control, and set its Name property to "cmdSave" and its Caption property to "Update."
5. Paste the following code into the form:

      Option Explicit
   
      Dim DiskFile As String
   
         Private Sub cmdNext_Click()
          If (rsset.RecordCount > 0) And (Not rsset.EOF) Then
           rsset.MoveNext
           If Not rsset.EOF Then
            rtbText.Text = ""
            ColumnToFile rsset.Fields("pr_info"), DiskFile
            FileToForm DiskFile, rtbText
           Else
            rsset.MoveLast
           End If
          End If
         End Sub
   
         Private Sub cmdPrev_Click()
          If (rsset.RecordCount > 0) And (Not rsset.BOF) Then
           rsset.MovePrevious
           If Not rsset.BOF Then
            rtbText.Text = ""
            ColumnToFile rsset.Fields("pr_info"), DiskFile
            FileToForm DiskFile, rtbText
           Else
            rsset.MoveFirst
           End If
          End If
         End Sub
   
         Private Sub cmdSave_Click()
          FormToFile DiskFile, rtbText
          FileToColumn rsset.Fields("pr_info"), DiskFile
         End Sub
   
         Private Sub Form_Activate()
          rtbText.Text = ""
          If rsset.RecordCount > 0 Then
           rsset.MoveFirst
           ColumnToFile rsset.Fields("pr_info"), DiskFile
           FileToForm DiskFile, rtbText
          End If
         End Sub
   
         Private Sub Form_Load()
   
          Dim ConnectString As String
          Dim anerror As ADODB.Error
          Dim Sql As String
   
          On Error GoTo handler
   
          DiskFile = App.Path & "\BLOB.txt"
   
          'Set the connect string to use pubs on your SQL server.
          ConnectString = _
          "Driver={SQL SERVER};Server=<yourserver>;Database=pubs;UID=sa;pwd=;"
          Sql = "SELECT pr_info FROM pub_info;"
          Set cn = New ADODB.Connection
          cn.ConnectionString = ConnectString
          cn.Open
          Set rsset = New ADODB.Recordset
          rsset.Open Sql, cn, adOpenKeyset, adLockOptimistic, adCmdText
         Exit Sub
   
         handler:
          For Each anerror In cn.Errors
           Debug.Print anerror.Number & ":  " & anerror.Description & _
           " - " & anerror.SQLState
          Next anerror
         End Sub

6. Change the ServerName in the connectstring to your server name.
7. Run the sample project. The RichTextBox will contain the first record of the recordset.
8. Click Next. Notice that the contents of the RichTextBox change to the next record until you reach the last record. The Next button calls the recordset's MoveNext method and then calls the ColumnToFile and FileToForm methods.
9. Click Prev. Notice that the contents of the RichTextBox change to the previous record until you reach the first record. The Prev button calls the recordset's MovePrevious method and then calls the ColumnToFile and FileToForm methods.
10. Type something new in the text box, and then click Update to modify the text field in whatever record you are on. The Update button calls the FormToFile and FileToColumn methods, which in turn calls the recordset's Update method. The new data should get updated in the database.