Post Method, Step3 (Visual Basic)

[This product will work only on Windows NT 4.0 versions and earlier. For Windows 2000 and later, see COM+ (Component Services).]

Public Function Post(ByVal lngAccountNo As Long, _
    ByVal lngAmount As Long) As String

    Dim strResult As String

    On Error GoTo ErrorHandler

    ' obtain the ADO environment and connection
    Dim adoConn As New ADODB.Connection
    Dim varRows As Variant

    adoConn.Open strConnect

    On Error GoTo ErrorCreateTable

    ' update the balance
    Dim strSQL As String
    strSQL = "UPDATE Account SET Balance = Balance + "_
        + Str$(lngAmount) + " WHERE AccountNo = "
        + Str$(lngAccountNo)

TryAgain:
    adoConn.Execute strSQL, varRows

    ' if anything else happens
    On Error GoTo ErrorHandler

    ' get resulting balance which may have been 
    ' further updated via triggers
    strSQL = "SELECT Balance FROM Account " _
        + "WHERE AccountNo = " + Str$(lngAccountNo)

    Dim adoRS As ADODB.Recordset
    Set adoRS = adoConn.Execute(strSQL)
    If adoRS.EOF Then
        Err.Raise Number:=APP_ERROR, _
            Description:="Error. Account " _
            + Str$(lngAccountNo) + " not on file."
    End If

    Dim lngBalance As Long
    lngBalance = adoRS.Fields("Balance").Value

    ' check if account is overdrawn
    If (lngBalance) < 0 Then
        Err.Raise Number:=APP_ERROR, _
            Description:="Error. Account " _
            + Str$(lngAccountNo) _
            + " would be overdrawn by " _
            + Str$(lngBalance) + ". Balance is still "
            + Str$(lngBalance - lngAmount) + "."
    Else
        If lngAmount < 0 Then
            strResult = strResult _
                & "Debit from account "
                & lngAccountNo & ", "
        Else
            strResult = strResult _
                & "Credit to account " 
                & lngAccountNo & ", "
        End If
        strResult = strResult + "balance is $" 
            & Str$(lngBalance) & ". (VB)"
    End If

    ' cleanup
    Set adoRS = Nothing
    Set adoConn = Nothing

    ' we are finished and happy
    GetObjectContext.SetComplete

    Post = strResult
    
Exit Function

ErrorCreateTable:
    On Error GoTo ErrorHandler
    
    ' create the account table
    Dim objCreateTable As CreateTable
    Set objCreateTable = _
    GetObjectContext.CreateInstance("Bank.CreateTable")
    objCreateTable.CreateAccount

    GoTo TryAgain

ErrorHandler:
    ' cleanup
    If Not adoRS Is Nothing Then
        Set adoRS = Nothing
    End If
    If Not adoConn Is Nothing Then
        Set adoConn = Nothing
    End If
    
    GetObjectContext.SetAbort          ' we are unhappy

    Post = ""         ' indicate that an error occurred
    Err.Raise Err.Number, "Bank.Accout.Post", _
        Err.Description

End Function