Aaron
Aaron

Reputation: 1989

VB6.0 with DataControl Database Programming

can you help out access the database... I have been reading some tutorials but I don't know where to start doing this one. I used DataControl to access the database. First, the program will prompt for the ID Number and then Search for the further information and display it in texboxes when Search Employee button clicked. I know how to set the properties of textboxes in order to appear the value of my database to my output without clicking the Search Employee button but I want to click first the button Search Employee. I'm a beginner in VB6. Please help me out! I need this project now.

Upvotes: 2

Views: 4640

Answers (1)

Mark Kram
Mark Kram

Reputation: 5832

Ok, I had some time to spare, here you go, first add a reference to Microsoft ActiveX Data Objects 2.X Library:

Form1 Code:

Option Explicit
''Add the following items to your form and name them as indicated:
''Four(4) text boxes - Named: tbIDNumber, tbName, tbAddress, and tbContactName.
''One(1) Command button - Named Command1

Private Sub Command1_Click()
Dim rs As ADODB.Recordset
Dim DB As cDatabase
Dim l As Long

Set rs = New ADODB.Recordset
Set DB = New cDatabase

    With DB
        .DBCursorType = adOpenForwardOnly
        .DBLockType = adLockReadOnly
        .DBOptions = adCmdText
        .DSNName = "Your_DSN_Name"
        .SQLUserID = "Your_SQL_Login_Name"
        .SQLPassword = "Your_SQL_Login_Password"
        Set rs = .GetRS("Select Name, Address, ContactNumber FROM YourTableName WHERE IDNumber = '" & tbIDNumber.Text & "'")
    End With

    If rs.RecordCount > 0 Then
        tbName.Text = rs(0).Value & ""
        tbAddress.Text = rs(1).Value & ""
        tbContactName.Text = rs(2).Value & ""
    End If

Exit_Sub:
rs.Close
Set rs = Nothing
Set DB = Nothing
End Sub

Add a Class Module Object to your project and name it cDatabase. Then copy the following Code into it:

Option Explicit

Private m_eDBCursorType As ADODB.CursorTypeEnum  'Cursor (Dynamic, Forward Only, Keyset, Static)
Private m_eDBLockType As ADODB.LockTypeEnum    'Locks (BatchOptimistic,Optimistic,Pessimistic, Read Only)
Private m_eDBOptions As ADODB.CommandTypeEnum 'DB Options
Private m_sDSNName As String
Private m_sSQLUserID As String
Private m_sSQLPassword As String
Private cn As ADODB.Connection

Private Sub Class_Initialize()
    m_eDBCursorType = adOpenForwardOnly
    m_eDBLockType = adLockReadOnly
    m_eDBOptions = adCmdText
End Sub

Private Function ConnectionString() As String

    ConnectionString = "DSN=" & m_sDSNName & "" & _
                            ";UID=" & m_sSQLUserID & _
                            ";PWD=" & m_sSQLPassword & ";"
''If you are using MS Access as your back end you will need to change the connection string to the following:
     ''ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _

''If you are using a DNS-Less connection to SQL Server, then you will need to change the connection string to the following:
     ''ConnectionString = "Data Source=myServerAddress;Initial Catalog=myDataBase;User Id=" & m_sSQLUserID & ";Password=" & m_sSQLPassword & ";"

''You can find more Connection Strings at http://connectionstrings.com/

End Function

Private Sub GetCN()
On Error GoTo GetCN_Error

If cn.State = 0 Then
StartCN:
    Set cn = New ADODB.Connection
    cn.Open ConnectionString

    With cn
        .CommandTimeout = 0
        .CursorLocation = adUseClient
    End With
End If


On Error GoTo 0
Exit Sub

GetCN_Error:
If Err.Number = 91 Then
    Resume StartCN
Else
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure GetCN of Module modDatabaseConnections"
End If

End Sub

Public Function GetRS(sSQL As String) As ADODB.Recordset

Dim eRS As ADODB.Recordset

On Error GoTo GetRS_Error

TryAgain:

If Len(Trim(sSQL)) > 0 Then
    Call GetCN

    Set eRS = New ADODB.Recordset       'Creates record set
    eRS.Open sSQL, cn, m_eDBCursorType, m_eDBLockType, m_eDBOptions
    Set GetRS = eRS

Else
    MsgBox "You have to submit a SQL String"
End If

On Error GoTo 0
Exit Function

GetRS_Error:
If Err.Number = 91 Then
    Call GetCN
    GoTo TryAgain
ElseIf Err.Number = -2147217900 Then
    Exit Function
Else
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure GetRS of Module" & vbCrLf & vbCrLf & "SQL - " & sSQL
End If

End Function

Public Property Get DBOptions() As ADODB.CommandTypeEnum

    DBOptions = m_eDBOptions

End Property

Public Property Let DBOptions(ByVal eDBOptions As ADODB.CommandTypeEnum)

    m_eDBOptions = eDBOptions

End Property

Public Property Get DBCursorType() As ADODB.CursorTypeEnum

    DBCursorType = m_eDBCursorType

End Property

Public Property Let DBCursorType(ByVal eDBCursorType As ADODB.CursorTypeEnum)

    m_eDBCursorType = eDBCursorType

End Property

Public Property Get DBLockType() As ADODB.LockTypeEnum

    DBLockType = m_eDBLockType

End Property

Public Property Let DBLockType(ByVal eDBLockType As ADODB.LockTypeEnum)

    m_eDBLockType = eDBLockType

End Property

Public Property Get DSNName() As String

    DSNName = m_sDSNName

End Property

Public Property Let DSNName(ByVal sDSNName As String)

    m_sDSNName = sDSNName

End Property

Public Property Get SQLUserID() As String

    SQLUserID = m_sSQLUserID

End Property

Public Property Let SQLUserID(ByVal sSQLUserID As String)

    m_sSQLUserID = sSQLUserID

End Property

Public Property Get SQLPassword() As String

    SQLPassword = m_sSQLPassword

End Property

Public Property Let SQLPassword(ByVal sSQLPassword As String)

    m_sSQLPassword = sSQLPassword

End Property

This should do the trick.

Upvotes: 3

Related Questions