Re: ADODB Recordset and Connection

Hi Piper,

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

Exit Sub ' <--- Exit Sub if not error

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


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

Exit Sub ' <--- Exit Sub if not error

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

--
Víctor Koch.


"Piper" <Piper@xxxxxxxxxxxxxxxxxxxxxxxxx> escribió en el mensaje
news:BB0D8FEE-C2F6-4C97-A29F-294354E91A92@xxxxxxxxxxxxxxxx
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: ADODB Recordset and Connection
    ... Sub setRcdSet(rcdSet As ADODB.Recordset, query As String) ... Set rcdSet = New ADODB.Recordset ... Cnxn = New ADODB.Connection ...
    (microsoft.public.data.ado)
  • Typen unverträglich
    ... Public Cnxn As ADODB.Connection ... Public Sub openDatabase() ... Function openRecordset(strSQL As String) As Recordset ... Dim rst As ADODB.Recordset ...
    (microsoft.public.de.access)
  • Re: ADODB Recordset and Connection
    ... Dim noPh As String, qry As String ... Dim rcdSet As New ADODB.Recordset ... Dim Cnxn As ADODB.Connection ...
    (microsoft.public.data.ado)
  • Project Error
    ... Private Declare Sub Sleep Lib "Kernel32" ... Dim strDataSrc As String ...
    (microsoft.public.vb.bugs)
  • RE: jpgs not showing on forms
    ... Rather than embed the pictures in the database store the paths to the JPEG ... Private Sub cmdAddImage_Click ... Dim strAdditionalTypes As String, strFileList As String ... Private Sub cmdDeleteImage_Click ...
    (microsoft.public.access.gettingstarted)