Solved

VB 6.0 & MS SQL examples using ADO and OLE DB

Posted on 1999-01-13
12
394 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 3
  • 2
  • +2
12 Comments
 

Author Comment

by:eyoung
ID: 1499017
Adjusted points to 300
0
 
LVL 4

Expert Comment

by:mcix
ID: 1499018
0
 
LVL 3

Expert Comment

by:BGillham
ID: 1499019
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
Salesforce Made Easy to Use

On-screen guidance at the moment of need enables you & your employees to focus on the core, you can now boost your adoption rates swiftly and simply with one easy tool.

 

Author Comment

by:eyoung
ID: 1499020
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
ID: 1499021
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
ID: 1499022
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
 

Author Comment

by:eyoung
ID: 1499023
Adjusted points to 400
0
 
LVL 3

Accepted Solution

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

Author Comment

by:eyoung
ID: 1499025
My email address is phoenixesy@earthlink.net

Thanks
0
 

Expert Comment

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

Expert Comment

by:cognition
ID: 4637105
Give me your amil and I will send you one !
0
 

Expert Comment

by:drippel
ID: 4637173
drippel@riscman.com - thanks :)
0

Featured Post

Revamp Your Training Process

Drastically shorten your training time with WalkMe's advanced online training solution that Guides your trainees to action.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
When designing a form there are several BorderStyles to choose from, all of which can be classified as either 'Fixed' or 'Sizable' and I'd guess that 'Fixed Single' or one of the other fixed types is the most popular choice. I assume it's the most p…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…

737 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