Solved

Connecting to MS SQL database server?

Posted on 2000-04-16
2
293 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

Creating Instructional Tutorials  

For Any Use & On Any Platform

Contextual Guidance at the moment of need helps your employees/users adopt software o& achieve even the most complex tasks instantly. Boost knowledge retention, software adoption & employee engagement with easy solution.

Question has a verified solution.

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

If you have ever used Microsoft Word then you know that it has a good spell checker and it may have occurred to you that the ability to check spelling might be a nice piece of functionality to add to certain applications of yours. Well the code that…
Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
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…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

707 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