Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

Assistance in linking a VB6 form to MS SQL Server

Posted on 2007-10-15
3
Medium Priority
?
161 Views
Last Modified: 2010-04-30
I'm a newbie working with Visual Basic 6 using MS SQL Server as the data source. The question that I have is how do I link a VB6 form to a MS SQL Server database?
 
0
Comment
Question by:jumpy262000
  • 2
3 Comments
 
LVL 1

Author Comment

by:jumpy262000
ID: 20080579
I have an older VB6 application that my ex-boss created before he left the company. He created a module and use this code:

Public objCnn As New ADODB.Connection
Public objCmd As New ADODB.Command
Public objRst As New ADODB.Recordset
Public objPrm As New ADODB.Parameter
Public Const SQLOLEDB = "Provider=SQLOLEDB.1;Password=jobprod2005;Persist Security Info=True;User ID=logi0001_admin;Initial Catalog=Logistics;Data Source=VCSQL1" 'CMH1-D1-W-SQL03"

Is this all that I have to do is hardcode the following:  password, user, database, and source?
0
 
LVL 1

Expert Comment

by:LostIt6
ID: 20081386
Add a module to your project and add the module code below. It requires a reference to MSADO. This function returns the number of results from your query or -1 if an error occured.

You can hopefully get an idea of how to use MSADO with my example or just use my module and example to piece somehting together.

' ####################### Module Code #######################
' Requires Reference to 'Microsoft ActiveX Data Objects 2.5 Library'
Option Explicit

Public Function RemoteCTQuery(ByVal SQLServer As String, ByVal mDataBase As String, ByVal mID As String, ByVal mPassWord As String, ByVal mQuery As String, Optional ByRef ErrStr As String, Optional ByRef Results As Variant) As Long ' Returns -1 if error
    On Error GoTo ERR_TRAP
    Dim conn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim mRes() As Variant
    Dim i As Long
    Dim r As Long
    Dim x As Long
    Dim y As Long
    Dim mStr As String
    Dim mBl As Boolean
    Dim mFieldCnt As Long
    RemoteCTQuery = -1
    If SQLServer = "" Then Exit Function
    If mDataBase = "" Then Exit Function
    Set conn = New ADODB.Connection
    Set rs = New ADODB.Recordset
    conn.ConnectionString = "Provider=SQLOLEDB.1;" _
                & "Password=" & mPassWord & ";" _
                & "Persist Security Info=True;" _
                & "User ID=" & mID & ";" _
                & "Initial Catalog=" & mDataBase & ";" _
                & "Data Source=" & SQLServer
               
    conn.CursorLocation = adUseClient  'to get right value from server
    conn.ConnectionTimeout = 10
    conn.Open
    rs.Open mQuery, conn
    RemoteCTQuery = rs.RecordCount
    ReDim mRes((rs.RecordCount * rs.Fields.Count) + rs.Fields.Count - 1)
    mFieldCnt = rs.Fields.Count
    If mFieldCnt <> 0 Then
        rs.GetRows
        rs.MoveFirst
        For y = 0 To rs.RecordCount
            For x = 0 To mFieldCnt - 1
                If y = 0 Then
                    ' Record 0 is actually the column headers (label)
                    mRes((x * (rs.RecordCount + 1)) + y) = rs.Fields(x).Name
                Else
                    If VarType(rs.Fields(x).Value) = vbNull Then
                        mRes((x * (rs.RecordCount + 1)) + y) = "NULL"
                    ElseIf VarType(rs.Fields(x).Value) = vbBoolean Then
                        mRes((x * (rs.RecordCount + 1)) + y) = rs.Fields(x).Value
                    Else
                        mRes((x * (rs.RecordCount + 1)) + y) = rs.Fields(x).Value
                    End If
                End If
            Next x
            If y > 0 Then rs.MoveNext
        Next y
    End If
    If rs.State <> 0 Then rs.Close
    If conn.State <> 0 Then conn.Close
    Set rs = Nothing
    Set conn = Nothing
    Results = mRes
    Exit Function
ERR_TRAP:
    ErrStr = Err.Description
End Function


' ####################### USAGE EXAMPLE #######################
Private Sub Command1_Click()
    Dim lRet As Long
    Dim sQuery As String
    Dim vRes() As Variant
    Dim mVar As Variant
    Dim i As Long
    Dim mFieldCnt As Long
    Dim mCurField As String
    sQuery = "SELECT * FROM Sometable" ' Example!
    lRet = SQLQuery("VCSQL1", "Logistics", "logi0001_admin", "jobprod2005", sQuery, serr, vRes, mFieldCnt)
    If lRet = -1 Then
        MsgBox serr
    ElseIf lRet > 0 Then
        ' vRes contains an array of your results.
        ' Process your results
        For y = 0 To lRet
            For x = 0 To mFieldCnt - 1
                mVar = mRes((x * (lRet + 1)) + y)
                If y = 0 Then
                    ' mVar = A Field Name
                    mCurField = mVar
                    ' ########
                    ' Add your code here
                    ' ########
                Else
                    ' mVar = A result
                    Debug.Print mCurField & ": " & CStr(mVar)
                    ' ########
                    ' Add your code here
                    ' ########
                End If
            Next x
        Next y
    End If
End Sub
0
 
LVL 1

Accepted Solution

by:
LostIt6 earned 2000 total points
ID: 20081400
I forgot to make a change the module code i nthe above post..... New code below (slight change but will not work as above)


' ####################### Module Code #######################
' Requires Reference to 'Microsoft ActiveX Data Objects 2.5 Library'
Option Explicit

Public Function SQLQuery(ByVal SQLServer As String, ByVal mDataBase As String, ByVal mID As String, ByVal mPassWord As String, ByVal mQuery As String, Optional ByRef ErrStr As String, Optional ByRef Results As Variant, Optional ByRef lFieldCnt As Long) As Long ' Returns -1 if error
    On Error GoTo ERR_TRAP
    Dim conn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim mRes() As Variant
    Dim i As Long
    Dim r As Long
    Dim x As Long
    Dim y As Long
    Dim mStr As String
    Dim mBl As Boolean
    Dim mFieldCnt As Long
    RemoteCTQuery = -1
    If SQLServer = "" Then Exit Function
    If mDataBase = "" Then Exit Function
    Set conn = New ADODB.Connection
    Set rs = New ADODB.Recordset
    conn.ConnectionString = "Provider=SQLOLEDB.1;" _
                & "Password=" & mPassWord & ";" _
                & "Persist Security Info=True;" _
                & "User ID=" & mID & ";" _
                & "Initial Catalog=" & mDataBase & ";" _
                & "Data Source=" & SQLServer
               
    conn.CursorLocation = adUseClient  'to get right value from server
    conn.ConnectionTimeout = 10
    conn.Open
    rs.Open mQuery, conn
    RemoteCTQuery = rs.RecordCount
    ReDim mRes((rs.RecordCount * rs.Fields.Count) + rs.Fields.Count - 1)
    mFieldCnt = rs.Fields.Count
    If mFieldCnt <> 0 Then
        rs.GetRows
        rs.MoveFirst
        For y = 0 To rs.RecordCount
            For x = 0 To mFieldCnt - 1
                If y = 0 Then
                    ' Record 0 is actually the column headers (label)
                    mRes((x * (rs.RecordCount + 1)) + y) = rs.Fields(x).Name
                Else
                    If VarType(rs.Fields(x).Value) = vbNull Then
                        mRes((x * (rs.RecordCount + 1)) + y) = "NULL"
                    ElseIf VarType(rs.Fields(x).Value) = vbBoolean Then
                        mRes((x * (rs.RecordCount + 1)) + y) = rs.Fields(x).Value
                    Else
                        mRes((x * (rs.RecordCount + 1)) + y) = rs.Fields(x).Value
                    End If
                End If
            Next x
            If y > 0 Then rs.MoveNext
        Next y
    End If
    If rs.State <> 0 Then rs.Close
    If conn.State <> 0 Then conn.Close
    Set rs = Nothing
    Set conn = Nothing
    lFieldCnt = (UBound(mRes) + 1) / (mResCnt + 1)
    Results = mRes
    Exit Function
ERR_TRAP:
    ErrStr = Err.Description
    MsgBox ErrStr, vbCritical + vbOKOnly, "Error communicating with the SQL Server"
End Function
0

Featured Post

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
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…
Suggested Courses
Course of the Month21 days, 5 hours left to enroll

810 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