Solved

Connecting to MS SQL database server?

Posted on 2000-04-16
2
292 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
[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
  • 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

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.

Question has a verified solution.

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

Suggested Solutions

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.
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
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…
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…

739 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