HelloData Code

'BeginHelloData
Option Explicit

Dim m_oRecordset As ADODB.Recordset
Dim m_sConnStr As String
Dim m_flgPriceUpdated As Boolean

Private Sub cmdGetData_Click()
    GetData

    If Not m_oRecordset Is Nothing Then
        If m_oRecordset.State = adStateOpen Then
            ' Set the proper states for the buttons.
            cmdGetData.Enabled = False
            cmdExamineData.Enabled = True
        End If
    End If
End Sub

Private Sub cmdExamineData_Click()
    ExamineData
End Sub

Private Sub cmdEditData_Click()
    EditData
End Sub

Private Sub cmdUpdateData_Click()
    UpdateData

    ' Set the proper states for the buttons.
    cmdUpdateData.Enabled = False
End Sub

Private Sub GetData()
    On Error GoTo GetDataError

    Dim sSQL As String
    Dim oConnection1 As ADODB.Connection

    m_sConnStr = "Provider='SQLOLEDB';Data Source='MySqlServer';" & _
                "Initial Catalog='Northwind';Integrated Security='SSPI';"

    ' Create and Open the Connection object.
    Set oConnection1 = New ADODB.Connection
    oConnection1.CursorLocation = adUseClient
    oConnection1.Open m_sConnStr

    sSQL = "SELECT ProductID, ProductName, CategoryID, UnitPrice " & _
             "FROM Products"

    ' Create and Open the Recordset object.
    Set m_oRecordset = New ADODB.Recordset
    m_oRecordset.Open sSQL, oConnection1, adOpenStatic, _
                        adLockBatchOptimistic, adCmdText

    m_oRecordset.MarshalOptions = adMarshalModifiedOnly

    ' Disconnect the Recordset.
    Set m_oRecordset.ActiveConnection = Nothing
    oConnection1.Close
    Set oConnection1 = Nothing

    ' Bind Recordset to the DataGrid for display.
    Set grdDisplay1.DataSource = m_oRecordset

    Exit Sub

GetDataError:
    If Err <> 0 Then
        If oConnection1 Is Nothing Then
           HandleErrs "GetData", m_oRecordset.ActiveConnection
        Else
           HandleErrs "GetData", oConnection1
        End If
    End If

    If Not oConnection1 Is Nothing Then
        If oConnection1.State = adStateOpen Then oConnection1.Close
        Set oConnection1 = Nothing
    End If
End Sub

Private Sub ExamineData()
    On Err GoTo ExamineDataErr

    Dim iNumRecords As Integer
    Dim vBookmark As Variant

    iNumRecords = m_oRecordset.RecordCount

    DisplayMsg "There are " & CStr(iNumRecords) & _
                " records in the current Recordset."

    ' Loop through the Recordset and print the
    ' value of the AbsolutePosition property.
    DisplayMsg "****** Start AbsolutePosition Loop ******"

    Do While Not m_oRecordset.EOF
        ' Store the bookmark for the 3rd record,
        ' for demo purposes.
        If m_oRecordset.AbsolutePosition = 3 Then _
            vBookmark = m_oRecordset.Bookmark

        DisplayMsg m_oRecordset.AbsolutePosition

        m_oRecordset.MoveNext
    Loop

    DisplayMsg "****** End AbsolutePosition Loop ******" & vbCrLf

    ' Use our bookmark to move back to 3rd record.
    m_oRecordset.Bookmark = vBookmark
    MsgBox vbCr & "Moved back to position " & _
            m_oRecordset.AbsolutePosition & " using bookmark.", , _
            "Hello Data"

    ' Display meta-data about each field. See WalkFields() sub.
    Call WalkFields

    ' Apply a filter on the type field.
    MsgBox "Filtering on type field. (CategoryID=2)", _
            vbOKOnly, "Hello Data"

    m_oRecordset.Filter = "CategoryID=2"

    ' Set the proper states for the buttons.
    cmdExamineData.Enabled = False
    cmdEditData.Enabled = True

    Exit Sub

ExamineDataErr:
    HandleErrs "ExamineData", m_oRecordset.ActiveConnection
End Sub

Private Sub EditData()
    On Error GoTo EditDataErr

    'Recordset still filtered on CategoryID=2.
    'Increase price by 10% for filtered records.
    MsgBox "Increasing unit price by 10%" & vbCr & _
        "for all records with CategoryID = 2.", , "Hello Data"

    m_oRecordset.MoveFirst

    Dim cVal As Currency
    Do While Not m_oRecordset.EOF
        cVal = m_oRecordset.Fields("UnitPrice").Value
        m_oRecordset.Fields("UnitPrice").Value = (cVal * 1.1)
        m_oRecordset.MoveNext
    Loop

    ' Set the proper states for the buttons.
    cmdEditData.Enabled = False
    cmdUpdateData.Enabled = True

    Exit Sub

EditDataErr:
    HandleErrs "EditData", m_oRecordset.ActiveConnection
End Sub

Private Sub UpdateData()
    On Error GoTo UpdateDataErr

    Dim oConnection2 As New ADODB.Connection

    MsgBox "Removing Filter (adFilterNone).", , "Hello Data"
    m_oRecordset.Filter = adFilterNone

    Set grdDisplay1.DataSource = Nothing
    Set grdDisplay1.DataSource = m_oRecordset

    MsgBox "Applying Filter (adFilterPendingRecords).", , "Hello Data"
    m_oRecordset.Filter = adFilterPendingRecords

    Set grdDisplay1.DataSource = Nothing
    Set grdDisplay1.DataSource = m_oRecordset

    DisplayMsg "*** PRE-UpdateBatch values for 'UnitPrice' field. ***"

    ' Display Value, UnderlyingValue, and OriginalValue for
    ' type field in first record.
    If m_oRecordset.Supports(adMovePrevious) Then
        m_oRecordset.MoveFirst
        DisplayMsg "OriginalValue   = " & _
            m_oRecordset.Fields("UnitPrice").OriginalValue
        DisplayMsg "Value           = " & _
            m_oRecordset.Fields("UnitPrice").Value
    End If

    oConnection2.ConnectionString = m_sConnStr
    oConnection2.Open

    Set m_oRecordset.ActiveConnection = oConnection2
    m_oRecordset.UpdateBatch

    m_flgPriceUpdated = True

    DisplayMsg "*** POST-UpdateBatch values for 'UnitPrice' field ***"

    If m_oRecordset.Supports(adMovePrevious) Then
         m_oRecordset.MoveFirst
         DisplayMsg "OriginalValue   = " & _
             m_oRecordset.Fields("UnitPrice").OriginalValue
         DisplayMsg "Value           = " & _
             m_oRecordset.Fields("UnitPrice").Value
    End If

    MsgBox "See value comparisons in txtDisplay.", , _
           "Hello Data"

    'Clean up
    oConnection2.Close
    Set oConnection2 = Nothing
    Exit Sub

UpdateDataErr:
    If Err <> 0 Then
        HandleErrs "UpdateData", oConnection2
    End If

    If Not oConnection2 Is Nothing Then
        If oConnection2.State = adStateOpen Then oConnection2.Close
        Set oConnection2 = Nothing
    End If
End Sub

Private Sub WalkFields()
    On Error GoTo WalkFieldsErr

    Dim iFldCnt As Integer
    Dim oFields As ADODB.Fields
    Dim oField As ADODB.Field
    Dim sMsg As String

    Set oFields = m_oRecordset.Fields

    DisplayMsg "****** BEGIN FIELDS WALK ******"

    For iFldCnt = 0 To (oFields.Count - 1)
        Set oField = oFields(iFldCnt)
        sMsg = ""
        sMsg = sMsg & oField.Name
        sMsg = sMsg & vbTab & "Type: " & GetTypeAsString(oField.Type)
        sMsg = sMsg & vbTab & "Defined Size: " & oField.DefinedSize
        sMsg = sMsg & vbTab & "Actual Size: " & oField.ActualSize

        grdDisplay1.SelStartCol = iFldCnt
        grdDisplay1.SelEndCol = iFldCnt
        DisplayMsg sMsg
        MsgBox sMsg, , "Hello Data"
    Next iFldCnt

    DisplayMsg "****** END FIELDS WALK ******" & vbCrLf

    'Clean up
    Set oField = Nothing
    Set oFields = Nothing
    Exit Sub

WalkFieldsErr:
    Set oField = Nothing
    Set oFields = Nothing

    If Err <> 0 Then
        MsgBox Err.Source & "-->" & Err.Description, , "Error"
    End If
End Sub

Private Function GetTypeAsString(dtType As ADODB.DataTypeEnum) As String
    ' To save space, we are only checking for data types
    ' that we know are present.
    Select Case dtType
        Case adChar
            GetTypeAsString = "adChar"
        Case adVarChar
            GetTypeAsString = "adVarChar"
        Case adVarWChar
            GetTypeAsString = "adVarWChar"
        Case adCurrency
            GetTypeAsString = "adCurrency"
        Case adInteger
            GetTypeAsString = "adInteger"
    End Select
End Function

Private Sub HandleErrs(sSource As String, ByRef m_oConnection As ADODB.Connection)
    DisplayMsg "ADO (OLE) ERROR IN " & sSource
    DisplayMsg vbTab & "Error: " & Err.Number
    DisplayMsg vbTab & "Description: " & Err.Description
    DisplayMsg vbTab & "Source: " & Err.Source

    If Not m_oConnection Is Nothing Then
        If m_oConnection.Errors.Count <> 0 Then
            DisplayMsg "PROVIDER ERROR"
            Dim oError1 As ADODB.Error
            For Each oError1 In m_oConnection.Errors
                DisplayMsg vbTab & "Error: " & oError1.Number
                DisplayMsg vbTab & "Description: " & oError1.Description
                DisplayMsg vbTab & "Source: " & oError1.Source
                DisplayMsg vbTab & "Native Error:" & oError1.NativeError
                DisplayMsg vbTab & "SQL State: " & oError1.SQLState
            Next oError1
            m_oConnection.Errors.Clear
            Set oError1 = Nothing
        End If
    End If

    MsgBox "Error(s) occurred. See txtDisplay1 for specific information.", , _
           "Hello Data"

    Err.Clear
End Sub

Private Sub DisplayMsg(sText As String)
    txtDisplay1.Text = (txtDisplay1.Text & vbCrLf & sText)
End Sub

Private Sub Form_Resize()
    grdDisplay1.Move 100, 700, Me.ScaleWidth - 200, (Me.ScaleHeight - 800) / 2
    txtDisplay1.Move 100, grdDisplay1.Top + grdDisplay1.Height + 100, _
                    Me.ScaleWidth - 200, (Me.ScaleHeight - 1000) / 2
End Sub

Private Sub Form_Load()
    cmdGetData.Enabled = True
    cmdExamineData.Enabled = False
    cmdEditData.Enabled = False
    cmdUpdateData.Enabled = False

    grdDisplay1.AllowAddNew = False
    grdDisplay1.AllowDelete = False
    grdDisplay1.AllowUpdate = False
    m_flgPriceUpdated = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error GoTo ErrHandler:

    Dim oConnection3 As New ADODB.Connection
    Dim sSQL As String
    Dim lAffected As Long

    ' Undo the changes we've made to the database on the server.
    If m_flgPriceUpdated Then
        sSQL = "UPDATE Products SET UnitPrice=(UnitPrice/1.1) " & _
            "WHERE CategoryID=2"
        oConnection3.Open m_sConnStr
        oConnection3.Execute sSQL, lAffected, adCmdText

        MsgBox "Restored prices for " & CStr(lAffected) & _
            " records affected.", , "Hello Data"
    End If

    'Clean up
    oConnection3.Close
    Set oConnection3 = Nothing
    m_oRecordset.Close
    Set m_oRecordset = Nothing
    Exit Sub

ErrHandler:

    If Not oConnection3 Is Nothing Then
        If oConnection3.State = adStateOpen Then oConnection3.Close
        Set oConnection3 = Nothing
    End If
    If Not m_oRecordset Is Nothing Then
        If m_oRecordset.State = adStateOpen Then m_oRecordset.Close
        Set m_oRecordset = Nothing
    End If
End Sub

'EndHelloData