Хорошо, у меня было немного свободного времени, сначала добавьте ссылку на Объекты данных Microsoft ActiveX 2.X Библиотека :
Код Form1:
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
Добавьте объект класса Class в свой проект и назовите его cDatabase . Затем скопируйте в него следующий код:
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
Это должно сработать.