by Hamish Indurain (3 Submissions)
Category: Databases/Data Access/DAO/ADO
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Sun 20th January 2002
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
By compiling this code as an OCX, you will be able to access an SQLServer 7 database with NO lines of code.
API Declarations
'control, add a dataEnvironment designer and compile as an OCX.
'Fill up the displayField property with the field from the table that
'you want displayed and fill up the SPName property with the storedProc
'name NOT the table name.
'There are 2 other properties that you can play around with. No free
'gifts for finding out what they do!.
VBcoders
Dim cmd As ADODB.Command
Dim prm As ADODB.Parameter
Dim mSPName As String
Dim mSPItemname As String
Dim mDisplayField As String
Dim mId As Long
Event transmitID(id As Long)
Dim myCol As New Collection
Private Sub dataCbo_Click()
On Error GoTo proc_err
Dim tempId As Long
Dim iList As Integer
iList = dataCbo.ListIndex + 1
tempId = CLng(myCol.Item(iList))
RaiseEvent transmitID(tempId)
proc_exit:
Exit Sub
proc_err:
MsgBox Err.Description
GoTo proc_exit
End Sub
Private Sub dataCbo_GotFocus()
On Error GoTo proc_err
Dim seqOfItems As Integer
If dataCbo.ListCount <> 0 Then GoTo proc_exit
Set rs = New ADODB.Recordset
Set cmd = New ADODB.Command
cmd.ActiveConnection = de.cnxn
cmd.CommandType = adCmdStoredProc
cmd.CommandText = SPName
Set rs = cmd.Execute()
seqOfItems = 0
rs.MoveFirst
Do Until rs.EOF = True
dataCbo.AddItem rs(displayField)
myCol.Add CStr(rs!id)
rs.MoveNext
Loop
proc_exit:
If rs.State = adStateOpen Then rs.Close
Set rs = Nothing
Set cmd = Nothing
Exit Sub
proc_err:
MsgBox Err.Description
GoTo proc_exit
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
SPName = PropBag.ReadProperty("SPName")
displayField = PropBag.ReadProperty("displayField")
End Sub
Private Sub UserControl_Resize()
dataCbo.Top = 0
dataCbo.Left = 0
dataCbo.Width = UserControl.Width
UserControl.Height = dataCbo.Height
End Sub
Private Sub UserControl_Show()
On Error GoTo proc_err
Dim seqOfItems As Integer
If incomingId <> 0 Then
If dataCbo.ListCount <> 0 Then GoTo proc_exit
Set rs = New ADODB.Recordset
Set cmd = New ADODB.Command
Set prm = New Parameter
cmd.ActiveConnection = de.cnxn
cmd.CommandType = adCmdStoredProc
cmd.CommandText = SPItemName
Set prm = cmd.CreateParameter("id", adInteger, adParamInput, 4, incomingId)
cmd.Parameters.Append prm
Set rs = cmd.Execute()
rs.MoveFirst
dataCbo.Text = rs(displayField)
End If
proc_exit:
If rs.State = adStateOpen Then rs.Close
Set rs = Nothing
Set prm = Nothing
Set cmd = Nothing
Exit Sub
proc_err:
MsgBox Err.Description
GoTo proc_exit
End If
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
PropBag.WriteProperty "SPName", SPName
PropBag.WriteProperty "displayField", displayField
End Sub
Public Property Let SPName(RHS As String)
mSPName = RHS
End Property
Public Property Get SPName() As String
SPName = mSPName
End Property
Public Property Let displayField(RHS As String)
mDisplayField = RHS
End Property
Public Property Get displayField() As String
displayField = mDisplayField
End Property
Public Property Let incomingId(RHS As Long)
mId = RHS
End Property
Public Property Get incomingId() As Long
incomingId = mId
End Property
Public Property Let SPItemName(RHS As String)
mSPItemname = RHS
End Property
Public Property Get SPItemName() As String
SPItemName = mSPItemname
End Property
No comments have been posted about By compiling this code as an OCX, you will be able to access an SQLServer 7 database with NO lines . Why not be the first to post a comment about By compiling this code as an OCX, you will be able to access an SQLServer 7 database with NO lines .
