In order to turn the MyData control into a data source, you'll need to add some code to handle connecting to the data and moving through the records. You'll also need to expose a number of properties to allow a developer using the control to select a data source at design time.
Note This topic is part of a series that walks you through creating sample data source components. It begins with the topic Creating Data Sources.
To add data handling code to the MyData control
' read only
Public Property Get RecordSet() As ADODB.RecordSet
Set RecordSet = rs
End Property
Public Property Get RecordSource() As String
RecordSource = m_RecordSource
End Property
Public Property Let RecordSource(ByVal New_RecordSource As String)
m_RecordSource = New_RecordSource
End Property
Public Property Get BOFAction() As BOFActionType
BOFAction = m_BOFAction
End Property
Public Property Let BOFAction(ByVal New_BOFAction As BOFActionType)
m_BOFAction = New_BOFAction
End Property
Public Property Get EOFAction() As EOFActionType
EOFAction = m_EOFAction
End Property
Public Property Let EOFAction(ByVal New_EOFAction As EOFActionType)
m_EOFAction = New_EOFAction
End Property
Public Property Get ConnectionString() As String
ConnectionString = m_ConnectionString
End Property
Public Property Let ConnectionString(ByVal New_ConnectionString _
As String)
m_ConnectionString = New_ConnectionString
End Property
Private Sub cmdFirst_Click()
If rs Is Nothing Then Exit Sub
rs.MoveFirst
End Sub
Private Sub cmdLast_Click()
If rs Is Nothing Then Exit Sub
rs.MoveLast
End Sub
Private Sub cmdPrev_Click()
If rs Is Nothing Then Exit Sub
If rs.BOF Then
Select Case m_BOFAction
Case BOFActionType.adDoMoveFirst
rs.MoveFirst
Case BOFActionType.adStayBOF
Exit Sub
Case Else
Exit Sub
End Select
Else
rs.MovePrevious
End If
End Sub
Private Sub cmdNext_Click()
If rs Is Nothing Then Exit Sub
If rs.EOF Then
Select Case m_EOFAction
Case EOFActionType.adDoAddNew
rs.AddNew
Case EOFActionType.adDoMoveLast
rs.MoveLast
Case EOFActionType.adStayEOF
Exit Sub
Case Else
Exit Sub
End Select
Else
rs.MoveNext
End If
End Sub
Private Sub UserControl_Terminate()
On Error Resume Next
If Not rs Is Nothing Then
rs.Close
Set rs = Nothing
End If
If Not cn Is Nothing Then
cn.Close
Set cn = Nothing
End If
Err.Clear
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
'Write property values to storage
Call PropBag.WriteProperty("Caption", _
lblCaption.Caption, Ambient.DisplayName)
Call PropBag.WriteProperty("RecordSource", _
m_RecordSource, m_def_RecordSource)
Call PropBag.WriteProperty("BOFAction", _
m_BOFAction, m_def_BOFAction)
Call PropBag.WriteProperty("EOFAction", _
m_EOFAction, m_def_EOFAction)
Call PropBag.WriteProperty("ConnectionString", _
m_ConnectionString, m_def_ConnectionString)
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
'Load property values from storage
lblCaption.Caption = PropBag.ReadProperty("Caption", _
Ambient.DisplayName)
m_RecordSource = PropBag.ReadProperty("RecordSource", _
m_def_RecordSource)
m_BOFAction = PropBag.ReadProperty("BOFAction", m_def_BOFAction)
m_EOFAction = PropBag.ReadProperty("EOFAction", m_def_EOFAction)
m_ConnectionString = PropBag.ReadProperty("ConnectionString", _
m_def_ConnectionString)
End Sub
Private Sub UserControl_GetDataMember(DataMember As String, _
Data As Object)
Dim conn As String
On Error GoTo GetDataMemberError
If rs Is Nothing Or cn Is Nothing Then
' make sure various properties have been set
If Trim$(m_ConnectionString) = "" Then
MsgBox "No ConnectionString Specified!", _
vbInformation, Ambient.DisplayName
Exit Sub
End If
If Trim$(m_RecordSource) = "" Then
MsgBox "No RecordSource Specified!", _
vbInformation, Ambient.DisplayName
Exit Sub
End If
If Trim$(m_ConnectionString) <> "" Then
' Create a Connection object and establish
' a connection.
Set cn = New ADODB.Connection
cn.ConnectionString = m_ConnectionString
cn.Open
' Create a RecordSet object.
Set rs = New ADODB.RecordSet
rs.Open m_RecordSource, cn, adOpenKeyset, adLockPessimistic
rs.MoveFirst
Else
Set cn = Nothing
Set rs = Nothing
End If
End If
Set Data = rs
Exit Sub
GetDataMemberError:
MsgBox "Error: " & CStr(Err.Number) & vbCrLf & vbCrLf & _
Err.Description, vbOKOnly, Ambient.DisplayName
Exit Sub
End Sub
In the next step we'll run our project to see the results.
This topic is part of a series that walks you through creating sample ActiveX data sources.
To | See |
Go to the next step | Running the MyDataControl Project |
Start from the beginning | Creating Data Sources |