• Home
 · 
• Databases/Data Access/DAO/ADO
 · 
• By compiling this code as an OCX, you will be able to access an SQLServer 7 database with NO lines

By compiling this code as an OCX, you will be able to access an SQLServer 7 database with NO lines

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!.



Rate By compiling this code as an OCX, you will be able to access an SQLServer 7 database with NO lines

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

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