p2p.wrox.com Forums

Need to download code?

View our list of code downloads.


  Return to Index  

vb_howto thread: Combo boxes ado and vb6


Message #1 by "Antwon Butler" <antwonj@h...> on Tue, 15 May 2001 19:02:40
Hello all, 
I have a project that requires a connnection to a sql server. 
It searches a database based on a records id number 
it returns a small set of records to one form. Information in text boxes 
and combo boxes need to be updated and saved back to the database. I need 
help with setting the combo boxes recordsource. 
The app works when im only use one collection of data defined in my 
collection object. But when I try to use a function to retrieve data from 
a different table it dies. ok here's what I have in a nutshell 

1. a connection class named DBSession: 

' open a connection to the Training database 
Public Function GetConn() As ADODB.Connection 
Dim conn As New ADODB.Connection 

On Error GoTo GetConn_Fail 
conn.Properties("Prompt") = adPromptAlways 'Prompts from a odbc dsn 
conn.Open "Driver={SQL Server};" & _ 
"Server=Trainws5;" & _ 
"DataBase=magic;" 


Set GetConn = conn 
Exit Function 

GetConn_Fail: 
MsgBox Err.description, vbCritical, Err.Source 
End Function 



Public Function GetTickets(Optional whereClause As String = "", _ 
Optional orderBy As String = "") As Collection 
Dim conn As ADODB.Connection 
Set conn = GetConn() 
If conn Is Nothing Then Exit Function 

Dim sSQL As String 
sSQL = "SELECT * FROM _SMDBA_.[Help Desk] " 

If Len(whereClause) > 0 Then 
sSQL = sSQL & "WHERE " & whereClause 
End If 
If Len(orderBy) > 0 Then 
sSQL = sSQL & " ORDER BY " & orderBy 
Else 
sSQL = sSQL & " ORDER BY _SMDBA_.[Help Desk].Problem#" 
End If 

Dim rs As New ADODB.Recordset 
rs.Open sSQL, conn, adOpenStatic, adLockReadOnly 

Dim coll As New Collection, tic As ticket 
Do While Not rs.EOF 
Set tic = New ticket 
tic.FromRs rs 
coll.Add tic, LTrim(Str(tic.ticket)) 
rs.MoveNext 
Loop 
Set GetTicketset = coll 
End Function 

Public Function GetSLA(Optional whereClause As String = "", _ 
Optional orderBy As String = "") As Collection 
Dim conn As ADODB.Connection 
Set conn = GetConn() 
If conn Is Nothing Then Exit Function 

Dim sSQL As String 
sSQL = "SELECT SLA_ID FROM _SMDBA_._SLA_ " 

If Len(whereClause) > 0 Then 
sSQL = sSQL & "WHERE " & whereClause 
End If 
If Len(orderBy) > 0 Then 
sSQL = sSQL & " ORDER BY " & orderBy 
Else 
sSQL = sSQL & " ORDER BY _SMDBA_._SLA_.SLA_ID" 
End If 

Dim rs As New ADODB.Recordset 
rs.Open sSQL, conn, adOpenStatic, adLockReadOnly 

Dim coll As New Collection, Sla_Id As ticket 
Do While Not rs.EOF 
Set Sla_Id = New ticket 
Sla_Id.FromRs rs 
coll.Add Sla_Id, LTrim(Str(Sla_Id.sla)) 
rs.MoveNext 
Loop 
Set GetSLA = coll 
End Function 


2. a class that encapsulate the db data 

Option Explicit 

Private m_ticket As Long 
Private m_desc As String 
Private m_reso As String 
Private m_note As String 
Private m_sl As String 
Private m_sla As String 



Public Property Get ticket() As Long 
ticket = m_ticket 
End Property 

Public Property Get desc() As String 
desc = m_desc 
End Property 

Public Property Let desc(x As String) 
m_desc = x 
End Property 

Public Property Get sl() As String 
sl = m_sl 
End Property 

Public Property Let sl(x As String) 
m_sl = x 
End Property 

Public Property Get reso() As String 
reso = m_reso 
End Property 

Public Property Let reso(x As String) 
m_reso = x 
End Property 

Public Property Get sla() As String 
sla = m_sla 
End Property 

Public Property Let sla(x As String) 
m_sla = x 
End Property 

Public Property Get Note() As String 
Note = m_note 
End Property 

Public Property Let Note(x As String) 
m_note = x 
End Property 

' validate that the required attributes are set and have valid values 
Public Function IsValid() As Boolean 
IsValid = (Len(m_ticket) > 0) 
End Function 

' retrieve a ticket based on the id passed in 
Public Function Find(ByVal ticket_num As Long) As Boolean 
ClearState 

Dim sSQL As String 
sSQL = "SELECT * FROM _SMDBA_.[Help Desk] WHERE _SMDBA_.[Help Desk].
[Problem #] =" _ 
& Str(ticket_num) 

Dim rs As New ADODB.Recordset 
rs.Open sSQL, gSession.GetConn(), adOpenStatic, adLockReadOnly 




If rs.RecordCount <= 0 Then Exit Function 

FromRs rs 
Find = True 
End Function 

' save the object to the persistent storage - the database 
Public Function Save() As Boolean 
' do validation for this object 
If Not IsValid() Then Exit Function 

Dim sSQL As String 
If m_ticket <= 0 Then ' New customer 
sSQL = "SELECT * FROM _SMDBA_.[Help Desk]" 
Else ' Existing customer 
sSQL = "SELECT * FROM _SMDBA_.[Help Desk] WHERE _SMDBA_.[Help Desk].
[Problem #] =" _ 
& Str(m_ticket) 
End If 

Dim conn As ADODB.Connection 
Set conn = gSession.GetConn 

Dim rs As New ADODB.Recordset 
rs.Open sSQL, conn, adOpenKeyset, adLockOptimistic 
If m_ticket <= 0 Then 
' If it is a new customer do an insert, otherwise update the recordset 
rs.AddNew 
End If 
ToRs rs 
rs.Update 
If m_ticket <= 0 Then m_ticket = rs![Problem #] ' retrieve the auto-
generated primary key 
Save = True 
End Function 

'Public Function Delete() As Boolean 
' ' check to see if the object has been retrieved 
'If ticket <= 0 Then Exit Function 

' Dim sSQL As String 
'sSQL = "DELETE FROM _SMDBA_.[Help Desk] WHERE _SMDBA_.[Help 
Desk].Problem# =" _ 
'& Str(m_id) 

Dim conn As ADODB.Connection 
Set conn = gSession.GetConn 
conn.Execute sSQL 
ClearState 
Delete = True 
End Function 

Public Sub ClearState() 
m_ticket = 0 
m_desc = "" 
m_reso = "" 
m_note = "" 
m_sl = "" 
m_sla = "" 
End Sub 

Public Sub FromRs(rs As ADODB.Recordset) 
m_ticket = rs![Problem #] 
m_desc = rs![Problem Description] 
m_reso = rs![Problem Resolution] 
m_sl = rs![Severity ID:] 
m_sla = rs![SLA ID] 
m_note = rs![Note] 

End Sub 

Public Sub ToRs(rs As ADODB.Recordset) 
rs![Problem #] = m_ticket 
rs![Severity ID:] = m_sl 
rs![SLA ID] = m_sla 
rs![Problem Resolution] = m_reso 
rs![Problem Description] = m_desc 
rs![Note] = m_note 

End Sub 

3. A utility module named modmain which basically creates a new instance 
of the database connection object. 

Option Explicit 

Public gSession As New DbSession 

4. The ticket form and code frmticket 

Option Explicit 

Private m_ticket As ticket 
Private m_ticketset As Collection 

Private Sub cmdCancel_Click() 
Unload Me 
End Sub 

Private Sub cmdSave_Click() 
FtoO 
If Not m_ticket.Save() Then Exit Sub 
Unload Me 
End Sub 

Private Sub Form_Unload(Cancel As Integer) 
Set m_ticket = Nothing 
Set m_ticketset = Nothing 
End Sub 

Public Sub SetData(tic As ticket) 
Set m_ticket = tic 
OtoF 
End Sub 

Public Sub OtoF() 
Me.txtTicket = m_ticket.ticket 
Me.txtDesc = m_ticket.desc 
Me.txtReso = m_ticket.reso 
Me.cmbSLA = m_ticket.sla 
Me.cmbSL = m_ticket.sl 
Me.txtNote = m_ticket.Note 

End Sub 

Public Sub FtoO() 
m_ticket.ticket = Me.txtTicket 
m_ticket.desc = Me.txtDesc 
m_ticket.reso = Me.txtReso 
m_ticket.sla = Me.cmbSLA 
m_ticket.sl = Me.cmbSL 
m_ticket.Note = Me.txtNote 

End Sub 




Private Sub cmdSearch_Click() 
If Len(txtTicket) > 0 Then 
FindTicket 
OtoF 
End If 
End Sub 

Private Sub FindTicket() 
Dim o As New ticket 
If Not o.find(Val(txtTicket)) Then 
MsgBox "Ticket #" & Str(txtTicket) & " was not found!", vbExclamation 
Exit Sub 
End If 

Set m_ticket = o 
Me.Tag = True 

End Sub 


I would really appreciate your help!


  Return to Index