ADODB Recordset and Connection



I'm having a slight problem in my code, it seems that my Connection and
Recordset Objects are possibly loosing scope? I'm trying to teach myself VB
as I'm going along, so please try not to laugh out loud if my code is
horrendously wrong. I am using an Access Database and I'm coding inside a
Form.

The Connection object is defined in the Declarations portion of the Form, my
understanding is that the scope is all coding within the form (and project as
I haven't declared it as Private). The ReccordSet is defined within a
procedure so it's scope is within that procedure. The problem I'm having is
that I pass the Connection and Recordset to another procedure to open them.
They show open in the procedure that actually opens them, but when it goes
back to the calling procedure they show closed.

I'm pretty sure that when you pass a variable to another procedure unless
you pass it ByVal the new procedure can change the value of it. I was hoping
that was so for Connections and Recordsets. I also tried making it Static but
then I got errors when I tried to pass it, probably because the procedure I
passed it to wasn't Static.

I know Java, and in that Language, you have to pass Objects by refrence if
you want to have the new procedure change the Object. So I'm thinking that's
whats going on?

I'd really apreciate any help.

Here's the code:

Option Compare Database
Option Explicit

Dim Cnxn As New ADODB.Connection
_________________________________________________________________
Sub createListBX()

Dim noPh As String, qry As String
Dim cpFrm As Form
Dim rcdSet As New ADODB.Recordset

noPh = getNme(Forms!Emp_Form!Emp_ID) + " has no Dept Issued Cell Phones."
qry = cpByIDQry(Forms!Emp_Form!Emp_ID)
setRcdSet rcdSet, qry

If rcdSet.EOF = True & rcdSet.BOF = True _
Then
'CP_ListBX.Height =
CP_ListBX.ColumnCount = 1
CP_ListBX.ColumnWidths = "3.75 in"
CP_ListBX.AddItem (noPh)
Else
fillListBX CP_ListBX, rcdSet
End If

cleanUpRcdSet rcdSet

End Sub
_________________________________________________________________
Sub createComboBX(cmboBX As ComboBox, ByVal empID As Integer)

Dim noCP As String, qry As String
Dim rcdSet As New ADODB.Recordset

noCP = "No Active Department Cell Phones In Database"
setRcdSet rcdSet, qry

If rcdSet.EOF = True & rcdSet.BOF = True _
Then
CP_CmboBX.ColumnCount = 1
CP_CmboBX.ColumnWidths = "3.75 in"
CP_CmboBX.AddItem (noCP)
Else
fillCmboBX CP_ListBX, rcdSet
End If

cleanUpRcdSet rcdSet

End Sub
_________________________________________________________________
Sub fillCmboBX(cmboBX As ComboBox, rcdSet As Recordset)

cmboBX.ColumnCount = 3
cmboBX.ColumnWidths = "1.25 in; 1.25 in; 1.25 in"

Do Until rcdSet.EOF
cmboBX.AddItem rcdSet(2) + ";" & rcdSet(3) + ";" & rcdSet(0)
rcdSet.MoveNext
Loop

End Sub
_________________________________________________________________
Sub fillListBX(lstBX As ListBox, rcdSet As ADODB.Recordset)

lstBX.ColumnCount = 3
lstBX.ColumnWidths = "1.25 in; 1.25 in; 1.25 in"

Do Until rcdSet.EOF
lstBX.AddItem rcdSet(2) + ";" & rcdSet(3) + ";" & rcdSet(0)
'lstBX.AddItem rcdSet!CP_Num + ";" & rcdSet!CP_Model + ";" _
& rcdSet!CP_CntyPropNum
rcdSet.MoveNext
Loop

End Sub
_________________________________________________________________
Sub setRcdSet(rcdSet As ADODB.Recordset, query As String)

On Error GoTo ErrorHandler

Set rcdSet = New ADODB.Recordset
rcdSet.Open query, Cnxn, adOpenDynamic, adLockOptimistic, adCmdText

ErrorHandler:
If Not rcdSet Is Nothing _
Then
If rcdSet.State = adStateOpen Then rcdSet.Close
End If

Set rcdSet = Nothing

If Err <> 0 _
Then
MsgBox Err.Source & "-->" & Err.Description & "in Private Sub " _
& "setRcdSet -> In EmpForm_CellPhoneSub_Form", vbOKOnly, _
"RecordSet Initialization Error"
End If

End Sub
_________________________________________________________________
Function cpByIDQry(ByVal id As Integer)

cpByIDQry = "SELECT CP_CntyPropNum, CP_EmpID, " _
& "CP_Num, CP_Model, CP_Active " _
& "FROM CellPhone_Tbl WHERE (((CP_EmpID)=" & id _
& ") AND ((CP_Active)=True));"

End Function
_________________________________________________________________
Function cpByActiveQry()

cpByActiveQry = "SELECT CellPhone_Tbl.CP_CntyPropNum,
CellPhone_Tbl.CP_EmpID, " _
+ "CellPhone_Tbl.CP_Num, CellPhone_Tbl.CP_Model,
CellPhone_Tbl.CP_Active " _
+ "FROM CellPhone_Tbl WHERE (((CellPhone_Tbl.CP_Active)=True));"

End Function
_________________________________________________________________
Function getNme(ByVal id As Integer)

Dim fNme As String, lNme As String

fNme = DLookup("[Emp_FNme]", "Employee_Tbl", "[Emp_ID] = " & id)
lNme = DLookup("[Emp_LNme]", "Employee_Tbl", "[Emp_ID] = " & id)

getNme = fNme & " " & lNme

End Function
_________________________________________________________________
Sub cleanUpCnxn(Cnxn As ADODB.Connection)

If Not Cnxn Is Nothing _
Then
If Cnxn.State = adStateOpen Then Cnxn.Close
End If

Set Cnxn = Nothing

End Sub
_________________________________________________________________
Sub cleanUpRcdSet(rcdSet As ADODB.Recordset)

If Not rcdSet Is Nothing _
Then
If rcdSet.State = adStateOpen Then rcdSet.Close
End If

Set rcdSet = Nothing

End Sub
_________________________________________________________________
Sub setCnxn()

On Error GoTo ErrorHandler

Dim cnxnStr As String

cnxnStr = "Driver={Microsoft Access Driver " _
& "(*.mdb)};Dbq=U:\PersonnelDB\CC_Personnel.mdb;"
Cnxn = New ADODB.Connection
Cnxn.Open cnxnStr

ErrorHandler:
If Not Cnxn Is Nothing _
Then
If Cnxn.State = adStateOpen Then Cnxn.Close
End If

Set Cnxn = Nothing

If Err <> 0 _
Then
MsgBox Err.Source & "-->" & Err.Description & "in Private Sub " _
& "setCnxn -> In EmpForm_CellPhoneSub_Form", vbOKOnly, _
"Connection Initialization Error"
End If

End Sub
_________________________________________________________________
Private Sub Form_Load()

createListBX
cleanUpCnxn Cnxn

End Sub


--
Piper
.



Relevant Pages

  • Re: strange slowness with getrows method
    ... > After creating the recordset objRS (not actually listed on code I ... Create a connection variable and open it at the beginning of your page: ... SUB DataGetrows(parmConn, parmSQL, byref parmArray, byref parmDict) ...
    (microsoft.public.inetserver.asp.db)
  • Re: Database Connection Sample - Pros and Cons
    ... tearing down the recordset just after i had ... Sub RunSQL(strSQL,strConnection, objRecordSet, blnNextRS, intTimeout) ... ' the connection object, then the connection object is closed. ...
    (microsoft.public.scripting.vbscript)
  • Database Connection Sample - Pros and Cons
    ... Connection to the DB is created and destroyed in the same sub, ... a disconnected recordset behind. ... Set objRecordSet = Server.CreateObject ...
    (microsoft.public.scripting.vbscript)
  • GetConnection
    ... I have this connection how to get several recordset from this ... Sub GetconnectionADOBD() ... Set cndb = New ADODB.Connection ...
    (microsoft.public.excel.programming)
  • Re: Emailing a Report
    ... Then Lotus Notes opens with the Reminders Report with a properly formatted email. ... Sub LoopAgmtsSendEmail(_ ... pSQL As String) ... 'pSQL -- defines the recordset to open ...
    (microsoft.public.access.modulesdaovba)