Improve company productivity with a Business Account.Sign Up

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 428
  • Last Modified:

VB 6.0 & MS SQL examples using ADO and OLE DB

I am a fairly new VB 6.0 programmer and I am looking for a ".VBP" that shows me an example of a simple form that uses ADO and OLE DB to connect to a MS SQL 6.5 database.  I just need to see how to program the from and its properties so I can do simple chores with the form such as ADD, CHANGE, DELETE, EXIT, NEXT, PREVIOUS, etc.

Although I have purchased a number of books on the subject, not one of them has a good example of a VB 6.0 form that uses ADO and OLE DB to connect to an MS SQL 6.5 database such as the sample 'PUBS' supplied by Microsoft.

Any suggestions where I can go to download or somehow obtain a .VBP that shows this so I can get off to a better start would be much appreciated.

Thank you.
0
eyoung
Asked:
eyoung
  • 5
  • 3
  • 2
  • +2
1 Solution
 
eyoungAuthor Commented:
Adjusted points to 300
0
 
mcixCommented:
0
 
BGillhamCommented:
There is no difference to the Syntax for ACCESS, SQL Server for the standard operations. If you create a Data Environment most of this will be done for you by the Designer. If you want specifics or a sample project I will send you one.

There are also samples on your MSDN CD.
0
Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
eyoungAuthor Commented:
I am looking for a sample .VBP and not a comment.  Additionally, there are differences between Access and SQL as far as the OLE DB connections are concerned.

Thank you anyway.
0
 
cognitionCommented:
The following is a DB class. You need to set most of the properties, and then call the connect class.

It has an execute method that will execute some SQL, and a OpennRS that will return a result set.

Public DB As New okADODB             ' Data Access

    DB.IntegratedSecurity = True
    DB.UserName = lsUserName
    DB.Password = lsPassword
   
    ' Create the connection to database
    If Not DB.Connect Then
        EndApplication
    Endif

    Dim rs As ADODB.Recordset
    Set rs = DB.OpenRS("SELECT * FROM UserGroup WHERE 1 = 2", adOpenKeyset, adLockOptimistic)
    With rs
        .AddNew
       
        rs!group_Updated = strUpdated
        rs!group_Updated_by = strUpdatedBy
        rs!group_name = txtName
        rs!group_description = txtDescription
       
        .Update
    End With
    InsGroup = rs!group_id


    Dim lrs As ADODB.Recordset

    cmbRightGroup.Clear
    ' Fill the combo boxes
    Set lrs = DB.OpenRS("SELECT DISTINCT Right_group FROM SystemRight " & strWhere & " ORDER BY Right_Group ", _
                    adOpenKeyset, adLockOptimistic)

    While Not lrs.EOF
            cmbRightGroup.AddItem lrs!right_group & ""
            lrs.MoveNext
    Wend
    lrs.Close


I hope this gets you started.


Paste the following into a class.
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 1  'vbDataSource
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "okADODB"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit

Public WithEvents rs As ADODB.Recordset
Attribute rs.VB_VarHelpID = -1
Public WithEvents cn As ADODB.Connection
Attribute cn.VB_VarHelpID = -1

Private mbWINNTIntegrated As Boolean        ' Integrated security or not.
Private msServerName As String
Private msDatabaseName As String
Private msDSName As String
Private msUserName As String
Private msPassword As String

Private Msg As String
Private Response As String

Const Title = "Server Connection"
Const MsgConnSucc = "Connection to server successful."
Const MsgConnUn = "No server connection."

Public Property Let IntegratedSecurity(bSecurity As Boolean)
    mbWINNTIntegrated = bSecurity
End Property
Public Property Get IntegratedSecurity() As Boolean
    IntegratedSecurity = mbWINNTIntegrated
End Property
Public Property Let ServerName(sServerName As String)
    msServerName = sServerName
End Property
Public Property Get ServerName() As String
    ServerName = msServerName
End Property
Public Property Let DatabaseName(sDatabaseName As String)
    msDatabaseName = sDatabaseName
End Property
Public Property Get DatabaseName() As String
    DatabaseName = msDatabaseName
End Property
Public Property Let DSName(sDSName As String)
    msDSName = sDSName
End Property
Public Property Get DSName() As String
    DSName = msDSName
End Property
Public Property Let UserName(sUserName As String)
    msUserName = sUserName
End Property
Public Property Get UserName() As String
    UserName = msUserName
End Property
Public Property Let Password(sPassword As String)
    msPassword = sPassword
End Property
Public Property Get Password() As String
    Password = msPassword
End Property

Public Function Execute(Source As String) As Integer

    Dim cmd As New ADODB.Command
    Dim nRecordsAffected As Long
   
    On Error GoTo EH
   
    Execute = True
   
    cmd.CommandText = Source
    cmd.ActiveConnection = cn
    cmd.CommandType = adCmdText
    cmd.Prepared = False

    cmd.Execute nRecordsAffected
   
    Execute = nRecordsAffected
   
    Exit Function
   
EH:
    Execute = 0
   
End Function
Public Function OpenRS(Source, Optional CursorType As CursorTypeEnum = adOpenUnspecified, Optional LockType As LockTypeEnum = adLockUnspecified, Optional Options As Long = -1) As ADODB.Recordset
    ' General function for returning a  recordset
   
    Dim lrs As New ADODB.Recordset
    lrs.Open Source, cn, CursorType, LockType, Options
    Set OpenRS = lrs
'    ' Get rid of the connection
    Set lrs = Nothing
End Function


Public Function Connect() As Boolean

    On Error GoTo ErrorConnect:
    Dim strCnn As String
   
    Connect = False
   
    ' Integrated Security
    mbWINNTIntegrated = True
     
    Set cn = New ADODB.Connection
     
     ' Set connection properties.
    cn.ConnectionTimeout = 10
   
    ' Decision code for login authorization type: WinNT or SQL Server.
    cn.Provider = "sqloledb"
    If mbWINNTIntegrated = True Then
        cn.Properties("Integrated Security").Value = "SSPI"
    Else
        cn.Properties("User ID").Value = msUserName
        cn.Properties("Password").Value = msPassword
    End If
   
    ' Change mousepointer while trying to open database.
    Screen.MousePointer = vbHourglass
   
    ' Open the database.
    'cn.DefaultDatabase = msDatabaseName
    ';DSN=" & msDSName & ";UID=" & msUserName & ";PWD=" & msPassword & ";Database=" & msDatabaseName
    'cn.Open "DSN=" & "JerseyTSS" & ";UID=" & "Oliver" & ";PWD=" & ""
    'cn.Open msDSName, msUserName, msPassword
    'cn.Open strCnn
    'cn.Open "DSN=JerseyTSS" & & ";UID=" & msUserName & ";PWD=" & msPassword & ";Database=" & msDatabaseName
   
    cn.Open "Server=" & msServerName
   
    ' Change mousepointer back to the default after open.
    Screen.MousePointer = vbDefault
    Connect = True
   
    Exit Function
   
ErrorConnect:
   
    MsgBox "And Erroro occured connecting to the database : " & vbCr & Err.Description, vbCritical + vbOKOnly, "Error"
   
    ' Error checking. Connection successful.
    If cn.state = adStateOpen Then
        ErrorLog 1
        Connect = True
        Exit Function
    End If
    ' Error checking. Connection unsuccessful.
    If cn.state <> adStateOpen Then
        ErrorLog 2
        Connect = False
        Exit Function
    End If
   
 
End Function


Private Sub ErrorLog(errcase As Integer)
   
    Dim errLoop As ADODB.Error
    Dim c As String
   
    ' Change mousepointer to normal.
    Screen.MousePointer = vbDefault

    Select Case errcase
           
        ' 1 = successful connection; if a non-provider error occurred, which
        '     can't be saved in the ADO Errors collection, error processing
        '     ends. If a provider error occurred, processing continues.
        Case 1, 2, 3
            If errcase = 1 Then
                If cn.Errors.Count = 0 Then
                    Exit Sub
                End If
            End If
           
        ' 2 = Notify user of no connection. Then go on to error logging.
            If errcase = 2 Then
                Response = MsgBox(MsgConnUn, vbOKOnly, Title)
            End If
       
        ' 3 = Error occurred during the attempt to execute or
        '       execution of the query.
            If errcase = 3 Then
                If cn.Errors.Count = 0 Then
                    Exit Sub
                End If
            End If
       
        ' Create each error message in the errors list box.
        ' Each string in the list box corresponds to an ADO Error property.
               
        ' Array items correspond to a set of properties for each
        '   ADO Error object.
        ' The HelpFile and HelpContext properties are not exposed.
         
             For Each errLoop In cn.Errors
               
                Dim strError(5)
                Dim i As Integer
               
                strError(0) = "Error Number: " & errLoop.Number
                strError(1) = "  Description: " & errLoop.Description
                strError(2) = "  Source: " & errLoop.Source
                strError(3) = "  SQL State: " & errLoop.SQLState
                strError(4) = "  Native Error: " & errLoop.NativeError
               
                ' Loop through first five properties of Error object.
                i = 0
                Do While i < 5
                    frmADOError.lstErrors.AddItem strError(i)
                    i = i + 1
                Loop
               
                ' Add a blank line after each error message.
                frmADOError.lstErrors.AddItem ""
           
            Next    ' Continue looping through ADO Errors collection.
           
           
            ' Create string for summary count of errors.
            c = cn.Errors.Count & " provider error(s) occurred."
           
            ' Display a count of the provider errors.
            frmADOError.lstErrors.AddItem c
            frmADOError.lstErrors.AddItem ""
            frmADOError.Show vbModal
           
            ' Clear the ADO errors collection.
            cn.Errors.Clear
       
        Case Else          ' Fall-through case statement.
            Exit Sub
   
    End Select
   
End Sub

Private Sub Class_Initialize()
'    Debug.Print "Initialise " & Now
End Sub

Private Sub Class_Terminate()
    Set cn = Nothing
    Set rs = Nothing
   
End Sub



Private Sub Class_GetDataMember(DataMember As String, Data As Object)
    ' TODO:  Return the appropriate recordset based on DataMember. For example:
   
    'Select Case DataMember
    'Case ""             ' Default
    '    Set Data = Nothing
    'Case Else           ' Default
    '    Set Data = rs
    'End Select
End Sub




Private Sub cn_BeginTransComplete(ByVal TransactionLevel As Long, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pConnection As ADODB.Connection)
    If Not pError Is Nothing Then
        MsgBox "BeginTrans Complete With Errors" & vbCr & pError.Description, vbCritical + vbOKOnly, "ADO Error"
    End If

End Sub

Private Sub cn_CommitTransComplete(ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pConnection As ADODB.Connection)
    If Not pError Is Nothing Then
        MsgBox "Commit Complete With Errors" & vbCr & pError.Description, vbCritical + vbOKOnly, "ADO Error"
    End If

End Sub

Private Sub cn_ConnectComplete(ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pConnection As ADODB.Connection)
    If Not pError Is Nothing Then
        MsgBox "Connect Complete With Errors" & vbCr & pError.Description, vbCritical + vbOKOnly, "ADO Error"
    End If

End Sub

Private Sub cn_Disconnect(adStatus As ADODB.EventStatusEnum, ByVal pConnection As ADODB.Connection)
    MsgBox "cn.disconnect"
   
End Sub

Private Sub cn_ExecuteComplete(ByVal RecordsAffected As Long, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pCommand As ADODB.Command, ByVal pRecordset As ADODB.Recordset, ByVal pConnection As ADODB.Connection)
   
    If Not pError Is Nothing Then
        MsgBox "Execute Complete With Errors" & vbCr & pError.Description, vbCritical + vbOKOnly, "ADO Error"
    End If
End Sub

Private Sub cn_InfoMessage(ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pConnection As ADODB.Connection)
'    If Not pError Is Nothing Then
'        MsgBox "InfoMessage With Errors" & vbCr & pError.Description, vbCritical + vbOKOnly, "ADO Error"
'    End If

End Sub

Private Sub cn_RollbackTransComplete(ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pConnection As ADODB.Connection)
    If Not pError Is Nothing Then
        MsgBox "Rollback Complete With Errors" & vbCr & pError.Description, vbCritical + vbOKOnly, "ADO Error"
    End If

End Sub



0
 
eyoungAuthor Commented:
Thank you for the response, but I am looking for a sample '.VBP' that I can download that shows me simple ADD, Change, Delete etc. examples of ADO and OLE DB with MS SQL.
0
 
eyoungAuthor Commented:
Adjusted points to 400
0
 
cognitionCommented:
Please provide your email address and I'll send one.
0
 
eyoungAuthor Commented:
My email address is phoenixesy@earthlink.net

Thanks
0
 
drippelCommented:
Gee.. wasted 40 points to see 'Please provide your email address and I'll send one.". Thanks.
0
 
cognitionCommented:
Give me your amil and I will send you one !
0
 
drippelCommented:
drippel@riscman.com - thanks :)
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

  • 5
  • 3
  • 2
  • +2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now