Solved

VB 6.0 & MS SQL examples using ADO and OLE DB

Posted on 1999-01-13
12
339 Views
Last Modified: 2013-12-25
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
Comment
Question by:eyoung
  • 5
  • 3
  • 2
  • +2
12 Comments
 

Author Comment

by:eyoung
Comment Utility
Adjusted points to 300
0
 
LVL 4

Expert Comment

by:mcix
Comment Utility
0
 
LVL 3

Expert Comment

by:BGillham
Comment Utility
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
 

Author Comment

by:eyoung
Comment Utility
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
 
LVL 3

Expert Comment

by:cognition
Comment Utility
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
 

Author Comment

by:eyoung
Comment Utility
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
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 

Author Comment

by:eyoung
Comment Utility
Adjusted points to 400
0
 
LVL 3

Accepted Solution

by:
cognition earned 400 total points
Comment Utility
Please provide your email address and I'll send one.
0
 

Author Comment

by:eyoung
Comment Utility
My email address is phoenixesy@earthlink.net

Thanks
0
 

Expert Comment

by:drippel
Comment Utility
Gee.. wasted 40 points to see 'Please provide your email address and I'll send one.". Thanks.
0
 
LVL 3

Expert Comment

by:cognition
Comment Utility
Give me your amil and I will send you one !
0
 

Expert Comment

by:drippel
Comment Utility
drippel@riscman.com - thanks :)
0

Featured Post

Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

Join & Write a Comment

The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

771 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now