I have manually set my Table Links which sped a certain part of my app up literally 200 times (set a DSN using SQL Native Client), however another module sits for about a minute, then throws an error on couldn't connect to a DB Server, then the query still works. Without manually modifying the Linked Tables it works within seconds but the other query takes forever.
Looking at the connector module is there anyway to just tell it to use the DSN directly to speed things up or fix why its doing something else THEN connecting to the native client?
Looking at the connector module is there anyway to just tell it to use the DSN directly to speed things up or fix why its doing something else THEN connecting to the native client?
Code:
Option Compare Database
Option Explicit
Private mcn As ADODB.Connection
Public Sub CreateConnection(cn As ADODB.Connection)
Dim bCreateConn As Boolean
Dim ErrNumber As Long, ErrSource As String, ErrDescription As String, ErrHelpFile As String, ErrHelpContext As Long
Dim db As Object 'DAO.Database
Dim tbl As Object 'DAO.TableDef
Dim ConnectionInfo() As String
Dim Index As Long
Dim EqualPosition As Long
Dim Server As String
Dim Database As String
If cn Is Nothing Then
bCreateConn = True
ElseIf cn.State = ADODB.adStateClosed Then
bCreateConn = True
Else
bCreateConn = False
End If
If bCreateConn Then
Set db = Application.CurrentDb
Set tbl = db.TableDefs("AccountingSystems")
If tbl.Connect = "" Then
Err.Raise vbObjectError + 99, "CreateConnection", "Not attached to a SQL database."
Exit Sub
End If
ConnectionInfo = Split(tbl.Connect, ";")
Set tbl = Nothing
Set db = Nothing
For Index = 0 To UBound(ConnectionInfo)
EqualPosition = InStr(1, ConnectionInfo(Index), "=")
Select Case UCase$(Left$(ConnectionInfo(Index), EqualPosition))
Case "SERVER="
Server = Mid$(ConnectionInfo(Index), EqualPosition + 1)
Case "DATABASE="
Database = Mid$(ConnectionInfo(Index), EqualPosition + 1)
End Select
Next
On Error Resume Next
Set cn = New ADODB.Connection
cn.ConnectionTimeout = 30
cn.CommandTimeout = 1000
cn.CursorLocation = adUseClient
cn.Open "PROVIDER=SQL Native Client;SERVER=" & Server & ";DATABASE=" & Database & ";Trusted_Connection=Yes" ';MARS Connection=True"
If cn.State = adStateClosed Or Err.Number <> 0 Then
Err.Clear
Set cn = Nothing
Set cn = New ADODB.Connection
cn.Provider = "SQLOLEDB"
cn.ConnectionTimeout = 30
cn.CommandTimeout = 1000
cn.CursorLocation = adUseClient
cn.Open "SERVER=" & Server & ";DATABASE=" & Database & ";Trusted_Connection=Yes"
If cn.State = adStateClosed Or Err.Number <> 0 Then
Err.Clear
Set cn = Nothing
Set cn = New ADODB.Connection
cn.ConnectionTimeout = 30
cn.CommandTimeout = 1000
cn.CursorLocation = adUseClient
cn.Open "DRIVER=SQL Server;SERVER=" & Server & ";DATABASE=" & Database & ";Trusted_Connection=Yes"
End If
End If
'cn.CursorLocation = adUseClient
If Err.Number <> 0 Then
ErrNumber = Err.Number
ErrSource = Err.Source
ErrDescription = Err.Description
ErrHelpFile = Err.HelpFile
ErrHelpContext = Err.HelpContext
End If
On Error GoTo 0
If ErrNumber <> 0 Then
Err.Raise ErrNumber, ErrSource, ErrDescription, ErrHelpFile, ErrHelpContext
End If
End If
End Sub
Public Property Get gcn() As ADODB.Connection
CreateConnection mcn
Set gcn = mcn
End Property
Public Sub DestroyConnection(cn As ADODB.Connection)
If Not cn Is Nothing Then
If cn.State = ADODB.adStateClosed Then
cn.Close
End If
Set cn = Nothing
End If
End Sub