Sorry for the long code (below) but I am still trying to get a connection to the SQL server. When I run the app, I get a run-time error '3704' with the description Operation is not allowed when the object is closed
Please help! I've attached my entire code for the data entry form:
Please help! I've attached my entire code for the data entry form:
Code:
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)
Set Conn = Nothing
Set rs = Nothing
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
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)
'If enteringnew Then Exit Sub
Select Case Index
Case 0 'First Record
'RecNav.MoveFirst
rs.MoveFirst
Case 1 'Previous Record
'RecNav.MoveBack
rs.MovePrevious
Case 2 'Next Record
'RecNav.MoveForward
rs.MoveNext
Case 3 'Last Record
'RecNav.MoveLast
rs.MoveLast
End Select
End Sub
Private Sub Form_Load()
'Me.WindowState = vbMaximized
'**********************************************
'Set and make the connection to the database.
Set Conn = New ADODB.Connection
'**********
'define the recordset access statement
Dim strSQL As String
strSQL = "SELECT * 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=URO -ABC0001"
Conn.Open
With rs
.CursorLocation = adUseClient
.CursorType = adOpenDynamic
.LockType = adLockOptimistic
End With
Exit Sub
Err_Exit:
ADOerror
'**************************
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
cboABranch.Text = rs!cboABranch
cboASuppliesType.Text = rs!cboASuppliesType
txtASal.Text = rs!txtASal
txtAAwd.Text = rs!txtAAwd
txtABen.Text = rs!txtABen
txtAOT.Text = rs!txtAOT
txtATrav.Text = rs!txtATrav
txtATrans.Text = rs!txtATrans
txtATraining.Text = rs!txtATraining
txtARCU.Text = rs!txtARCU
txtAPrn.Text = rs!txtAPrn
txtAContract.Text = rs!txtAContract
lblASupResult.Caption = rs!lblASupResult
txtACC.Text = rs!txtACC
txtAPO.Text = rs!txtAPO
txtAGenOff.Text = rs!txtAGenOff
txtACOSA.Text = rs!txtACOSA
txtAOfficeDepot.Text = rs!txtAOfficeDepot
txtAEquip.Text = rs!txtAEquip
txtALand.Text = rs!txtALand
txtATort.Text = rs!txtATort
txtAInterest.Text = rs!txtAInterest
txtARemark.Text = rs!txtARemark
txtTotalAlloc = rs!txtTotalAlloc
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)
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
