Solved

Connecting to MS SQL database server?

Posted on 2000-04-16
2
283 Views
Last Modified: 2013-11-23
Hi,
my friend has MS SQL 7.0 evaluvation version running on his PC and we are connected by a LAN. How do I connect to the server running on his machine using VB?
0
Comment
Question by:joeDream
  • 2
2 Comments
 
LVL 2

Expert Comment

by:DanAvni
ID: 2720258
give me your email. i will send you a class that does everything you need from SQL server.
0
 
LVL 2

Accepted Solution

by:
DanAvni earned 100 total points
ID: 2720262
Use this class.
in the initialize enter the name of the sql server
you may also need to change the connection string to hold the database name,username,passwort you are connecting to.

Option Explicit

Dim m_DBServer As String
Dim m_ConnectionString As String

Private Sub Class_Initialize() 'used instead of the construct evemnt for now!
   m_DBServer = "MISGAV01"
End Sub

Function GetConnectionString() As String
    If m_ConnectionString <> "" Then
        GetConnectionString = m_ConnectionString
    Else
        'assume that we want to use a SQL Server connection through OLDEB
        If m_DBServer <> "" Then
            GetConnectionString = "Provider=SQLOLEDB.1;Password=OfficeCoreSQLServerLoginPassword;Persist Security Info=True;User ID=OfficeCoreSQLServerLoginID;Initial Catalog=OfficeCore;Data Source=" & m_DBServer & ";Locale Identifier=1037;Connect Timeout=15;Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096"
        Else
            GetConnectionString = "Provider=SQLOLEDB.1;Password=OfficeCoreSQLServerLoginPassword;Persist Security Info=True;User ID=OfficeCoreSQLServerLoginID;Initial Catalog=OfficeCore;Data Source=localhost;Locale Identifier=1037;Connect Timeout=15;Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096"
        End If
    End If
End Function

Function RunSPReturnRS(ByVal strSP As String, ParamArray params() As Variant) As ADODB.Recordset
    On Error GoTo errorHandler
   
    ' Create the ADO objects
    Dim rs As ADODB.Recordset, cmd As ADODB.Command
    Set rs = New ADODB.Recordset
    Set cmd = New ADODB.Command
   
    ' Init the ADO objects  & the stored proc parameters
    cmd.ActiveConnection = GetConnectionString()
    cmd.CommandText = strSP
    cmd.CommandType = adCmdStoredProc
   
    collectParams cmd, params
   
    ' Execute the query for readonly
    rs.CursorLocation = adUseClient
    rs.Open cmd, , adOpenForwardOnly, adLockReadOnly
   
    ' Disconnect the recordset
    Set cmd.ActiveConnection = Nothing
    Set cmd = Nothing
    Set rs.ActiveConnection = Nothing

    ' Return the resultant recordset
    Set RunSPReturnRS = rs
    Exit Function
   
errorHandler:
    Set rs = Nothing
    Set cmd = Nothing
    'RaiseError m_modName, "RunSPReturnRS(" & strSP & ", ...)"
End Function

' RunSQLReturnRS differs from RunSPReturnRS only on the line that
' sets the cmd.CommandType = adCmdText vs. adCmdStoredProc

Function RunSQLReturnRS(ByVal strSP As String, ParamArray params() As Variant) As ADODB.Recordset
    On Error GoTo errorHandler
   
    ' Set up Command and Connection objects
    Dim rs As ADODB.Recordset, cmd As ADODB.Command
    Set rs = New ADODB.Recordset
    Set cmd = New ADODB.Command

    'Run the procedure
    cmd.ActiveConnection = GetConnectionString()
    cmd.CommandText = strSP
    cmd.CommandType = adCmdText
   
    collectParams cmd, params
   
    rs.CursorLocation = adUseClient
    rs.Open cmd, , adOpenForwardOnly, adLockReadOnly
   
    ' Disconnect the recordsets and cleanup
    Set cmd.ActiveConnection = Nothing
    Set cmd = Nothing
    Set rs.ActiveConnection = Nothing
   
    Set RunSQLReturnRS = rs
    Exit Function
   
errorHandler:
    Set rs = Nothing
    Set cmd = Nothing
    'RaiseError m_modName, "RunSQLReturnRS(" & strSP & ", ...)"
End Function

Function RunSPReturnRS_RW(ByVal strSP As String, ParamArray params() As Variant) As ADODB.Recordset
    On Error GoTo errorHandler
   
    ' Create the ADO objects
    Dim rs As ADODB.Recordset, cmd As ADODB.Command
    Set rs = New ADODB.Recordset
    Set cmd = New ADODB.Command
   
    ' Init the ADO objects & the stored proc parameters
    cmd.ActiveConnection = GetConnectionString()
    cmd.CommandText = strSP
    cmd.CommandType = adCmdStoredProc
    collectParams cmd, params
    rs.CursorLocation = adUseClient
   
    ' Execute the query as an updatable recordset and stay connected
    rs.Open cmd, , adOpenDynamic, adLockBatchOptimistic
    Set cmd = Nothing
   
    ' Return and quit
    Set RunSPReturnRS_RW = rs
    Exit Function
   
errorHandler:
    Set rs = Nothing
    Set cmd = Nothing
    'RaiseError m_modName, "RunSPReturnRS_RW(" & strSP & ", ...)"
End Function

Function RunSQLReturnRS_RW(ByVal strSP As String, ParamArray params() As Variant) As ADODB.Recordset
    On Error GoTo errorHandler
   
    ' Create the ADO objects
    Dim rs As ADODB.Recordset, cmd As ADODB.Command
    Set rs = New ADODB.Recordset
    Set cmd = New ADODB.Command
       
    ' Init the ADO objects & the stored proc parameters
    cmd.ActiveConnection = GetConnectionString()
    cmd.CommandText = strSP
    cmd.CommandType = adCmdText
    collectParams cmd, params
    rs.CursorLocation = adUseClient
   
    ' Execute the query as an updatable recordset and stay connected
    rs.Open cmd, , adOpenDynamic, adLockBatchOptimistic
    Set cmd = Nothing
   
    ' Return and quit
    Set RunSQLReturnRS_RW = rs
    Exit Function
   
errorHandler:
    Set rs = Nothing
    Set cmd = Nothing
    'RaiseError m_modName, "RunSQLReturnRS_RW(" & strSP & ", ...)"
End Function

Function RunSP(ByVal strSP As String, ParamArray params() As Variant)
    On Error GoTo errorHandler
   
    ' Create the ADO objects
    Dim cmd As ADODB.Command
    Set cmd = New ADODB.Command
   
    ' Init the ADO objects & the stored proc parameters
    cmd.ActiveConnection = GetConnectionString()
    cmd.CommandText = strSP
    cmd.CommandType = adCmdStoredProc
    collectParams cmd, params
   
    ' Execute the query without returning a recordset
    cmd.Execute , , adExecuteNoRecords
   
    ' Disconnect the recordset and clean up
    Set cmd.ActiveConnection = Nothing
    Set cmd = Nothing
   
    Exit Function
   
errorHandler:
    Set cmd = Nothing
    'RaiseError m_modName, "RunSP(" & strSP & ", ...)"
End Function

Function RunSQL(ByVal strSP As String, ParamArray params() As Variant)
    On Error GoTo errorHandler
   
    ' Create the ADO objects
    Dim cmd As ADODB.Command
    Set cmd = New ADODB.Command

    ' Init the ADO objects & the stored proc parameters
    cmd.ActiveConnection = GetConnectionString()
    cmd.CommandText = strSP
    cmd.CommandType = adCmdText
    collectParams cmd, params
   
    ' Execute the query without returning a recordset
    cmd.Execute , , adExecuteNoRecords
   
    ' Cleanup
    Set cmd.ActiveConnection = Nothing
    Set cmd = Nothing
   
    Exit Function
   
errorHandler:
    Set cmd = Nothing
    'RaiseError m_modName, "RunSQL(" & strSP & ", ...)"
End Function

Function RunSPReturnInteger(ByVal strSP As String, ParamArray params() As Variant) As Long 'adInterger is really a VB Long
    On Error GoTo errorHandler
   
    ' Create the ADO objects
    Dim cmd As ADODB.Command
    Set cmd = New ADODB.Command
   
    ' Init the ADO objects & the stored proc parameters
    cmd.ActiveConnection = GetConnectionString()
    cmd.CommandText = strSP
    cmd.CommandType = adCmdStoredProc
    collectParams cmd, params
   
    ' Assume the last parameter is outgoing
    cmd.Parameters.Append cmd.CreateParameter("@retval", adInteger, adParamOutput, 4)
   
    ' Execute without a resulting recordset and pull out the "return value" parameter
    cmd.Execute , , adExecuteNoRecords
    RunSPReturnInteger = cmd.Parameters("@retval").Value
   
    ' Disconnect the recordset, and clean up
    Set cmd.ActiveConnection = Nothing
    Set cmd = Nothing
   
    Exit Function
   
errorHandler:
    Set cmd = Nothing
    'RaiseError m_modName, "RunSPReturnInteger(" & strSP & ", ...)"
End Function

Private Sub collectParams(ByRef cmd As ADODB.Command, ParamArray argparams() As Variant)
    Dim params As Variant, v As Variant
    Dim I As Integer, l As Integer, u As Integer
   
    params = argparams(0)
    For I = LBound(params) To UBound(params)
        l = LBound(params(I))
        u = UBound(params(I))
        ' Check for nulls.
        If u - l = 3 Then
            If VarType(params(I)(3)) = vbString Then
                v = IIf(params(I)(3) = "", Null, params(I)(3))
            Else
                v = params(I)(3)
            End If
            cmd.Parameters.Append cmd.CreateParameter(params(I)(0), params(I)(1), adParamInput, params(I)(2), v)
        Else
            'CtxRaiseError m_modName, "collectParams(...): incorrect # of parameters"
        End If
    Next I
End Sub

0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
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…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
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…

932 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

13 Experts available now in Live!

Get 1:1 Help Now