Results 1 to 3 of 3
  1. #1
    Join Date
    May 2003
    Location
    Dallas
    Posts
    817
    Provided Answers: 5

    Unanswered: ADO connection string function

    I converted an ADP to Accdb format and now I am working out the minor differences.

    The previous developer used active connection string to connect for calling stored procedures Which now that code will not function because the active connection string is to the Accdb file not the sql server

    below is how gthe developer coded the calling of the stored procedures

    I need a function to use to create the string prior to issuing the command.execute

    any help today would be appreciated


    Dim cmd As New ADODB.Command

    DoCmd.Hourglass True
    With cmd
    .ActiveConnection = CurrentProject.BaseConnectionString - this no longer works so I need a function here to make that connection - there is no sql validation(passwords) - all is NT authentication.
    .CommandType = adCmdStoredProc
    .CommandText = "name of stored procedure"
    .Execute
    End With
    DoCmd.Hourglass False
    Dale Houston, TX

  2. #2
    Join Date
    Mar 2009
    Posts
    5,442
    Provided Answers: 14
    You can store the connection string to the server in several places:
    - In a local table.
    - In a user-defines property of the CurrentDb object:
    - In an .ini file.

    A) User-defined property. The following classes can be used.
    Note: Cls_Std_Identity has no real purpose here but is needed because the code is an excerpt from a custom development framework. You can remove any reference to it in Cls_Std_DbProperties if you want.
    1. The Cls_Std_Identity class:
    Code:
    Private Declare Function GetTickCount Lib "kernel32" () As Long
    
    ' =         ---------------------------------------
    ' =         *            Cls_Std_  Class          *
    ' =         ---------------------------------------
    ' =
    ' =         This section is common  to all Cls_Std classes.
    ' =
    ' =
    Private Const c_strStd_ClassName As String = "Cls_Std_Identity"
    Private Const c_strStd_ClassGUID As String = "{361C4F60-421F-49A8-8E2A-D58507DCB93C}"
    Private Const c_strStd_ClassBuild As String = "20111004-2.1.19"
    Private m_strIdentity As String
    
    Public Property Get ClassBuild() As String
    
        ClassBuild = c_strStd_ClassBuild
    
    End Property
    
    Public Property Get ClassGUID() As String
    
        ClassGUID = c_strStd_ClassGUID
    
    End Property
    
    Public Property Get ClassName() As String
    
        ClassName = c_strStd_ClassName
    
    End Property
    
    Public Property Get Identity() As String
    
        Identity = m_strIdentity
    
    End Property
    '
    Private Sub Class_Initialize()
    
        m_strIdentity = Format(GetTickCount, "00000000") & Format(Int((99 - 1) * Rnd), "00") & Format(Int((99 - 1) * Rnd), "00")
        Randomize GetTickCount
        m_strIdentity = m_strIdentity & Format(Int((99 - 1) * Rnd), "00") & Format(Int((99 - 1) * Rnd), "00")
    
    End Sub
    2. The Cls_Std_DbProperties class:
    Code:
    Private m_lngLastError As Long
    
    ' =         ---------------------------------------
    ' =         *            Cls_Std_  Class          *
    ' =         ---------------------------------------
    ' =
    ' =         This section is common  to all Cls_Std classes.
    ' =
    
    Private Const c_strStd_ClassName As String = "Cls_Std_DbProperties"
    Private Const c_strStd_ClassGUID As String = "{8E71EE88-5511-4AE5-9B75-CD056A645306}"
    Private Const c_strStd_ClassBuild As String = "20111019-2.1.2"
    
    Private m_clsIdentity As Cls_Std_Identity
    
    Public Property Get ClassBuild() As String
    
        ClassBuild = c_strStd_ClassBuild
    
    End Property
    
    Public Property Get ClassGUID() As String
    
        ClassGUID = c_strStd_ClassGUID
    
    End Property
    
    Public Property Get ClassName() As String
    
        ClassName = c_strStd_ClassName
    
    End Property
    
    Public Property Get Identity() As String
    
        Identity = m_clsIdentity.Identity
    
    End Property
    '
    Private Sub Class_Initialize()
    
        Set m_clsIdentity = New Cls_Std_Identity
    
    End Sub
    
    Private Sub Class_Terminate()
    
        Set m_clsIdentity = Nothing
    
    End Sub
    
    Public Property Get Count()
    
        Count = CurrentDb.Properties.Count
    
    End Property
    
    Public Property Get Enumerate(Optional ByVal BuiltIn As Boolean = False) As Variant
    
        On Error GoTo Err_EnumerateDBProperty
    
        Dim dbs As DAO.Database
        Dim pty As DAO.Property
        Dim strPtyName As String
        Dim strPtyValue As String
        Dim strname As String
        Dim var(0 To 1) As Variant
    
        Set dbs = CurrentDb
        For Each pty In dbs.Properties
            strname = ""
            Select Case SystemPty(pty.Name)
                Case -1:    If BuiltIn = True Then strname = pty.Name
                Case 0:     strname = pty.Name
            End Select
            If Len(strname) > 0 Then
                If Len(strPtyName) > 0 Then strPtyName = strPtyName & Chr(11)
                strPtyName = strPtyName & pty.Name
                If Len(strPtyValue) > 0 Then strPtyValue = strPtyValue & Chr(11)
                strPtyValue = strPtyValue & pty.Value
            End If
        Next pty
        var(0) = Split(strPtyName, Chr(11))
        var(1) = Split(strPtyValue, Chr(11))
        Enumerate = var
        m_lngLastError = 0
    
    Exit_EnumerateDBProperty:
        Set pty = Nothing
        Set dbs = Nothing
        Exit Property
    
    Err_EnumerateDBProperty:
        m_lngLastError = Err.Number
        Resume Exit_EnumerateDBProperty
    
    End Property
    
    Public Property Get Exists(ByVal PropertyName As String, Optional ByVal BuiltIn As Boolean = False) As Boolean
    
        On Error GoTo Err_ExistsDBProperty
    
        Dim dbs As DAO.Database
        Dim pty As DAO.Property
        Dim strname As String
    
        Set dbs = CurrentDb
        For Each pty In dbs.Properties
            Select Case SystemPty(pty.Name)
                Case -1:    If BuiltIn = True Then strname = pty.Name
                Case 0:     strname = pty.Name
            End Select
            If strname = PropertyName Then
                Exists = True
                Exit For
            End If
        Next pty
        m_lngLastError = 0
    
    Exit_ExistsDBProperty:
        Set pty = Nothing
        Set dbs = Nothing
        Exit Property
    
    Err_ExistsDBProperty:
        m_lngLastError = Err.Number
        Resume Exit_ExistsDBProperty
    
    End Property
    
    Public Property Get LastError() As Long
    
        LastError = m_lngLastError
    
    End Property
    
    Public Sub Remove(ByVal PropertyName As String)
    
        On Error GoTo Err_RemoveDBProperty
    
        Dim dbs As DAO.Database
    
        Set dbs = CurrentDb
        If Exists(PropertyName) Then dbs.Properties.Delete PropertyName
        dbs.Properties.Refresh
        m_lngLastError = 0
    
    Exit_RemoveDBProperty:
        Set dbs = Nothing
        Exit Sub
    
    Err_RemoveDBProperty:
        m_lngLastError = Err.Number
        Resume Exit_RemoveDBProperty
    
    End Sub
    
    Public Property Get Success() As Boolean
    
        Success = (m_lngLastError = 0)
    
    End Property
    
    Private Function SystemPty(ByVal PropertyName As String) As Long
    
        Select Case PropertyName
            Case "Connection"
                SystemPty = 1
            Case "Name", "Connect", "Transactions", "Updatable", "CollatingOrder", _
                 "QueryTimeout", "Version", "RecordsAffected", "ReplicaID", "DesignMasterID", _
                 "ANSI Query Mode", "AccessVersion", "ProjVer", "Build", "DefaultBackupLocation"
                SystemPty = -1
            Case Else
                SystemPty = 0
        End Select
    
    End Function
    
    Public Property Get Value(ByVal Index As Variant, Optional ByVal BuiltIn As Boolean = False) As Variant
    
        On Error GoTo Err_GetDBProperty
    
        If IsNumeric(Index) = True Then
            If CurrentDb.Properties(Index).Name <> "Connection" Then
                Value = CurrentDb.Properties(Index).Value
            Else
                Value = Null
            End If
        Else
            If Exists(Index, BuiltIn) = True Then
                Value = CurrentDb.Properties(Index).Value
            Else
                Value = Null
            End If
        End If
        m_lngLastError = 0
    
    Exit_GetDBProperty:
        Exit Property
    
    Err_GetDBProperty:
        m_lngLastError = Err.Number
        Resume Exit_GetDBProperty
    
    End Property
    
    Public Property Let Value(ByVal Index As Variant, Optional ByVal BuiltIn As Boolean = False, ByVal PropertyValue As Variant)
    
        On Error GoTo Err_SetDBProperty
    
        Dim dbs As DAO.Database
        Dim pty As DAO.Property
    
        Set dbs = CurrentDb
        If Exists(Index) Then
            Set pty = dbs.Properties(Index)
            pty.Value = CStr(PropertyValue)
        ElseIf SystemPty(Index) = 0 Then
            Set pty = dbs.CreateProperty(Index, dbText, CStr(PropertyValue))
            dbs.Properties.Append pty
        End If
        dbs.Properties.Refresh
        m_lngLastError = 0
    
    Exit_SetDBProperty:
        Set pty = Nothing
        Set dbs = Nothing
        Exit Property
    
    Err_SetDBProperty:
        m_lngLastError = Err.Number
        Resume Exit_SetDBProperty
    
    End Property
    Example:
    1. To create a SQLConnect property (here for ODBC, change for ADO if necessary):
    Code:
    Public Sub CreateSQLConnect()
    
        Const c_SQL As String = "ODBC;DRIVER={SQL Server};SERVER=ISKENDER;DATABASE=Sales;Trusted_Connection=Yes;"
        
        Dim clsDbProperties As Cls_Std_DbProperties
        
        Set clsDbProperties = New Cls_Std_DbProperties
        clsDbProperties.Value("SQLConnect") = c_SQL
        Set clsDbProperties = Nothing
        
    End Sub
    2. To retrieve the value of the SQLConnect property:
    Code:
    Public Function GetSQLConnect() As String
    
        Dim clsDbProperties As Cls_Std_DbProperties
        
        Set clsDbProperties = New Cls_Std_DbProperties
        GetSQLConnect = clsDbProperties.Value("SQLConnect")
        Set clsDbProperties = Nothing
        
    End Function
    B) .ini file. The following function can be used.
    Note: By default, the .ini file has the same name as the Access database but with an .ini extension (instead of .mdb or .accdb). The line in the .ini file containing the connection string is:
    Code:
    SQLConnect=ODBC;DRIVER={SQL Server};SERVER=ISKENDER;DATABASE=Sales;Trusted_Connection=Yes;
    Code:
    Public Function GetSQLConnect(Optional ByVal FileName As String)
    
        Dim var As Variant
        Dim strFileName As String
        Dim strLine As String
        Dim intHandle As Integer
        
        If Len(FileName) = 0 Then
            strFileName = Left(CurrentDb.Name, InStrRev(CurrentDb.Name, ".")) & "ini"
        Else
            strFileName = FileName
        End If
        If Len(Dir(strFileName)) > 0 Then
            intHandle = FreeFile
            Open strFileName For Input As #intHandle
            Do Until EOF(intHandle)
                Line Input #intHandle, strLine
                var = Split(strLine, "=", 2)
                If var(0) = "SQLConnect" Then
                    GetSQLConnect = Trim(var(1))
                    Exit Do
                End If
            Loop
            Close #intHandle
        Else
            MsgBox "File not found: " & strFileName
        End If
        
    End Function
    Have a nice day!

  3. #3
    Join Date
    May 2003
    Location
    Dallas
    Posts
    817
    Provided Answers: 5

    I will post solution

    All I did was create a connection that can be used for annyone anywhere - I did not need the sql connection - just and open connection to the sql server and database

    Your code was awesome for any situation - but for for connecting just to the database to call a stored procedure I think my function is pretty spot on.

    I will post this snippet when I get back to my dev machine later today.
    Dale Houston, TX

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •