VB 6.0 Connection to SQL Server Issues

Option Explicit
    Dim ABranch As String
    Dim ASal As Double
    Dim AAwd As Double
    Dim ABen As Double
    Dim AOT As Double
    Dim ATrav As Double
    Dim ATrans As Double
    Dim ATraining As Double
    Dim ARCU As Double
    Dim APrn As Double
    Dim AContract As Double
    Dim ASupplies As Double
    Dim ASuppliesType As String
    Dim APO As Double
    Dim ACC As Double
    Dim AGenOff As Double
    Dim ACOSA As Double
    Dim AOfficeDepot As Double
    Dim AEquip As Double
    Dim ALand As Double
    Dim ATort As Double
    Dim AInterest As Double
    Dim ARemark As String
    Dim TotalBranchAllocation As Double
    
Dim Conn As ADODB.Connection
Dim rs As ADODB.Recordset

Private Sub Form_Unload(cancel As Integer)
    If Not rs Is Nothing Then
       If rs.State = adStateOpen Then rs.Close
       Set rs = Nothing
    End If
    If Not Conn Is Nothing Then
       If Conn.State = adStateOpen Then Conn.Close
       Set Conn = Nothing
    End If
    Unload Me
End Sub

   
Private Sub cboABranch_LostFocus()
     'If ABranch = "" Then
        'MsgBox ("You must pick a branch")
        'cboABranch.SetFocus
     'End If
End Sub

Private Sub cmdADel_Click()
    Dim check
    Dim cancel
    Beep
    check = MsgBox(" Are you sure you want to delete Current Record? ", vbQuestion + vbYesNo, "Confirm")

    If check = vbYes Then
        rs.Delete
        rs.MoveNext
    Else
        cancel = True
    End If
End Sub

Private Sub cmdANew_Click()

    rs.AddNew
    
    cboABranch.Text = ""
    cboASuppliesType.Text = ""
    txtASal.Text = 0
    txtAAwd.Text = 0
    txtABen.Text = 0
    txtAOT.Text = 0
    txtATrav.Text = 0
    txtATrans.Text = 0
    txtATraining.Text = 0
    txtARCU.Text = 0
    txtAPrn.Text = 0
    txtAContract.Text = 0
    lblASupResult.Caption = "0.00"
    txtACC.Text = 0
    txtAPO.Text = 0
    txtAGenOff.Text = 0
    txtACOSA.Text = 0
    txtAOfficeDepot.Text = 0
    txtAEquip.Text = 0
    txtALand.Text = 0
    txtATort.Text = 0
    txtAInterest.Text = 0
    txtARemark.Text = " "
    txtTotalAlloc = 0
    
End Sub

Private Sub cmdAReset_Click()
    Dim check
    Dim cancel
    Beep
    check = MsgBox(" Are you sure you want to ERASE every field? ", vbQuestion + vbYesNo, "Confirm")

    If check = vbYes Then
        rs.Update
    Else
        cancel = True
    End If
End Sub

Private Sub cmdNav_Click(Index As Integer)
    
    Select Case Index
        Case 0      'First Record
            rs.MoveFirst
        Case 1      'Previous Record
            rs.MovePrevious
            If rs.BOF Then rs.MoveFirst
        Case 2      'Next Record
            rs.MoveNext
            If rs.EOF Then rs.MoveLast
        Case 3      'Last Record
            rs.MoveLast
    End Select
        
End Sub

Private Sub Form_Load()

    'Branch Dropdown
    cboABranch.AddItem ""
    cboABranch.AddItem "EXEC"
    cboABranch.AddItem "AMB"
    cboABranch.AddItem "CLAIMS"
    cboABranch.AddItem "ISB"
    cboABranch.AddItem "POB"
            
    'Supplies Type dropdown
    cboASuppliesType.AddItem ""
    cboASuppliesType.AddItem "COSA"
    cboASuppliesType.AddItem "Office Deport"
    cboASuppliesType.AddItem "Credit Card"
    cboASuppliesType.AddItem "Contracts"
            
    'Set and make the connection to the database.
    Set Conn = New ADODB.Connection
        
    'define the recordset access statement
    Dim strSQL As String
    strSQL = "SELECT * FROM Allocation"
    Set rs = New ADODB.Recordset
        
    On Error GoTo Err_Exit
    
    Conn.ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=dbFSF;Data Source=Server1"
    Conn.Open
    
    With rs
        .ActiveConnection = Conn
        .CursorLocation = adUseServer
        .CursorType = adOpenDynamic
        .LockType = adLockOptimistic
        .Source = strSQL
        .Open
    End With

Exit Sub

Err_Exit:
    ADOerror
End Sub

Private Sub cmdAClose_Click()
    Unload Me
    Load Splash
    Splash.Show vbModeless
End Sub

Private Sub cmdASave_Click()
    ABranch = cboABranch.Text
    ASuppliesType = cboASuppliesType.Text
    ASal = CDbl(txtASal.Text)
    AAwd = CDbl(txtAAwd.Text)
    ABen = CDbl(txtABen.Text)
    AOT = CDbl(txtAOT.Text)
    ATrav = CDbl(txtATrav.Text)
    ATrans = CDbl(txtATrans.Text)
    ATraining = CDbl(txtATraining.Text)
    ARCU = CDbl(txtARCU.Text)
    APrn = CDbl(txtAPrn.Text)
    AContract = CDbl(txtAContract.Text)
    APO = CDbl(txtAPO.Text)
    ACC = CDbl(txtACC.Text)
    ACOSA = CDbl(txtACOSA.Text)
    AOfficeDepot = CDbl(txtAOfficeDepot.Text)
    'AGenOff = CDbl(txtAGenOff.Text)
    AGenOff = CDbl(ACOSA + AOfficeDepot)
    txtAGenOff = FormatCurrency(AGenOff)
    ASupplies = CDbl(APO + ACC + AGenOff)
    lblASupResult.Caption = FormatCurrency(ASupplies)
    AEquip = CDbl(txtAEquip.Text)
    ALand = CDbl(txtALand.Text)
    ATort = CDbl(txtATort.Text)
    AInterest = CDbl(txtAInterest.Text)
    ARemark = txtARemark.Text
    
    'ASal and ABen not included
    TotalBranchAllocation = CDbl(AAwd + AOT + ATrav + ATrans + ATraining + _
                                ARCU + APrn + AContract + ASupplies + _
                                AEquip + ALand + ATort + AInterest)
    txtTotalAlloc = FormatCurrency(TotalBranchAllocation)
    
    'Assigning values
    With rs
        .Fields("ABranch") = cboABranch.Text 
        .Fields("ASuppliesType") = cboASuppliesType.Text
        .Fields("ASal") = CDbl(txtASal.Text)
        .Fields("AAwd") = CDbl(txtAAwd.Text)
        .Fields("ABen") = CDbl(txtABen.Text)
        .Fields("AOT") = CDbl(txtAOT.Text)
        .Fields("ATrav") = CDbl(txtATrav.Text)
        .Fields("ATrans") = CDbl(txtATrans.Text)
        .Fields("ATraining") = CDbl(txtATraining.Text)
        .Fields("ARCU") = CDbl(txtARCU.Text)
        .Fields("APrn") = CDbl(txtAPrn.Text)
        .Fields("AContract") = CDbl(txtAContract.Text)
        .Fields("APO") = CDbl(txtAPO.Text)
        .Fields("ACC") = CDbl(txtACC.Text)
        .Fields("ACOSA") = CDbl(txtACOSA.Text)
        .Fields("AOfficeDepot") = CDbl(txtAOfficeDepot.Text)
        .Fields("AGenOff") = CDbl(txtAGenOff)
        .Fields("ATrans") = CDbl(txtATrans.Text)
        .Fields("ASupplies") = CDbl(ASupplies)
        .Fields("AEquip") = CDbl(txtAEquip.Text)
        .Fields("ALand") = CDbl(txtALand.Text)
        .Fields("ATort") = CDbl(txtATort.Text)
        .Fields("AInterest") = CDbl(txtAInterest.Text)
        .Fields("ARemark") = txtARemark.Text
        .Fields("BranchAllotment") = CDbl(txtTotalAlloc)
        .Update
      End With
        
End Sub

Private Sub ADOerror()
'/ Enumerate the Errors collection and display properties of each Error object
   Dim errCollection As Variant
   Dim errLoop  As Error
   Dim strError As String
   Dim iCounter As Integer

   On Error Resume Next    '/ in case ADO connection not set or other init problems
   iCounter = 1
   strError = " "
   For Each errLoop In errCollection
      With errLoop
         strError = _
            "Error #" & iCounter & vbCrLf & _
            "  ADO Error #" & .Number & vbCrLf & _
            "  Description - " & .Description & vbCrLf & _
            "  Error Source - " & .Source & vbCrLf
            Debug.Print strError
            iCounter = iCounter + 1
      End With
   Next
End Sub