Page 1 of 2 12 LastLast
Results 1 to 15 of 25
  1. #1
    techieanalyst is offline Novice
    Windows 8 Access 2010 32bit
    Join Date
    Jul 2013
    Posts
    16

    Issue with code for DB Connecting

    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?

    Clarification, under my current linked tables, those tables just show DATABASE: Apps, which seems to take about 30 seconds just to figure out what to do, manually editing the tables and pointing them to DSN: Techie Database:Apps literally makes this go by in seconds, however another part of the access system throws up, and im not sure why

    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

  2. #2
    Dal Jeanis is offline VIP
    Windows XP Access 2010 32bit
    Join Date
    May 2013
    Location
    Dallas TX
    Posts
    1,742
    This looks backwards. If it's closed you're going to close it?
    Code:
    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

  3. #3
    techieanalyst is offline Novice
    Windows 8 Access 2010 32bit
    Join Date
    Jul 2013
    Posts
    16
    What should I change here?

  4. #4
    Dal Jeanis is offline VIP
    Windows XP Access 2010 32bit
    Join Date
    May 2013
    Location
    Dallas TX
    Posts
    1,742
    change that to
    Code:
    If cn.State NOT = ADODB.adStateClosed Then
    Don't think that's your problem though.

    Here's another quick code cleanup.

    This allows you to kill one level of nesting
    Code:
     If cn Is Nothing Then
            bCreateConn = True
        ElseIf cn.State = ADODB.adStateClosed Then
            bCreateConn = True
        Else
            bCreateConn = False
    ' add this next line here
           Exit Sub
    End If
    
    'then delete this line
    '    If bCreateConn Then
    
    ' and delete the final End If before End Sub
    '   End If
    If you're a real geek, you could also kill the bCreateConn variable itself by replacing the above if - elseif - else coded in blue with this code:
    Code:
     'Exit if the connection exists and is already open
        If NZ(cn.State, ADODB.adStateClosed) <> ADODB.adStateClosed Then
            Exit Sub
        End If
    
    I'm still looking for your real issue. This is just getting the underbrush cleared.
    Last edited by Dal Jeanis; 07-31-2013 at 12:50 PM. Reason: correct to read If cn.State NOT = ADODB.adStateClosed Then

  5. #5
    Dal Jeanis is offline VIP
    Windows XP Access 2010 32bit
    Join Date
    May 2013
    Location
    Dallas TX
    Posts
    1,742
    Hey, heavy hitters - does this cn parameter need to be passed By Ref in order to set the called parameter's connection to nothing? Or does setting the connection to nothing kill the passed variable regardless?
    Code:
    Public Sub DestroyConnection(By Ref??? cn As ADODB.Connection)
        If Not cn Is Nothing Then
            If cn.State NOT = ADODB.adStateClosed Then
                cn.Close
            End If
            Set cn = Nothing
        End If
    End Sub

  6. #6
    techieanalyst is offline Novice
    Windows 8 Access 2010 32bit
    Join Date
    Jul 2013
    Posts
    16
    Yes so without going into Linked Table Manager and setting a DSN, everything works, but one of the queries to SQL is dead slow, when I say slow I mean literally mintues, use to take seconds, using SQL Native its fast, SQL Server or Access = slow as death, and actually I don't need a DSN for them to work (fun eh?)

    When I set the DNS manually the query time is literally second vs minutes, but now this ONE piece doesn't work which is annoying.

    The app was originally built up over 10 years by dozens of people, this is the last thing I have to fix up before Im finished cleaning up

  7. #7
    Dal Jeanis is offline VIP
    Windows XP Access 2010 32bit
    Join Date
    May 2013
    Location
    Dallas TX
    Posts
    1,742
    Okay, copy the database to a play copy, and replace that code with this code.
    Code:
    Option Compare Database
    Option Explicit
    Private mcn As ADODB.Connection
    
    Public Sub CreateConnection(cn As ADODB.Connection)
        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
    
       'Exit if the connection exists and is already open
        If Nz(cn.State, ADODB.adStateClosed) <> ADODB.adStateClosed Then
            Exit Sub
        End If
        
        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), "=")
            Debug.Print Index & "   " & ConnectionInfo(Index) & "  =Pos is " & EqualPosition
            
            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
    
        Debug.Print "SERVER = " & Server
        Debug.Print "DATABASE = " & Database
    
        On Error Resume Next
        
        ' attempt 1 - PROVODER SQL Native Client
        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"
    
        ' exit if good connection achieved
        If cn.State = adStateOpen And Err.Number = 0 Then
            Exit Sub
        End If
        
        ' report and clear any errors
        DebugConnectionErrs cn
        Err.Clear
        DestroyConnection cn
        
        ' attempt 2 - PROVIDER SQLOLEDB
        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"
    
        ' exit if good connection achieved
        If cn.State = adStateOpen And Err.Number = 0 Then
            Exit Sub
        End If
        
        ' report and clear any errors
        DebugConnectionErrs cn
        Err.Clear
        DestroyConnection cn
        
        ' attempt 3 - DRIVER {SQL SERVER}
        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"
    
        ' exit if good connection achieved
        If cn.State = adStateOpen And Err.Number = 0 Then
            Exit Sub
        End If
        
        ' report any errors
        DebugConnectionErrs cn
        MsgBox "*****Connection Cannot Be Established*****" & vbCrLf & _
               "Error Number  : " & Err.Number & vbCrLf & _
               "Error Source  : " & Err.Source & vbCrLf & _
               "Error Descr   : " & Err.Description & vbCrLf & _
               "Error Help    : " & Err.HelpFile & vbCrLf & _
               "Error Context : " & Err.HelpContext
        DestroyConnection cn
    
    End Sub
    
    Sub DebugConnectionErrs(cn As ADODB.Connection)
           Dim Errs1 As Errors
           Dim intErr As Integer
           Dim errLoop As Error
           Dim strErrTmp As String
    
           intErr = 1
    
           On Error Resume Next
    
           ' Enumerate Errors collection and display properties of
           ' each Error object (if Errors Collection is filled out)
           Set Errs1 = cn.Errors
           For Each errLoop In Errs1
              With errLoop
                 strErrTmp = strErrTmp & vbCrLf & "ADO Error # " & i & ":"
                 strErrTmp = strErrTmp & vbCrLf & "   ADO Error   # " & .Number
                 strErrTmp = strErrTmp & vbCrLf & "   Description   " & .Description
                 strErrTmp = strErrTmp & vbCrLf & "   Source        " & .Source
                 intErr = intErr + 1
              End With
           Next
    
           ' Get VB Error Object's information
           strErrTmp = strErrTmp & vbCrLf & "VB Error # " & Str(Err.Number)
           strErrTmp = strErrTmp & vbCrLf & "   Generated by " & Err.Source
           strErrTmp = strErrTmp & vbCrLf & "   Description  " & Err.Description
    
           Debug.Print strErrTmp
          'MsgBox strErrTmp
    
           ' Clean up gracefully without risking infinite loop in error handler
           On Error GoTo 0
           GoTo CreateConnection_Exit
        
    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 NOT = ADODB.adStateClosed Then
                cn.Close
            End If
            Set cn = Nothing
        End If
    End Sub
    Open your immediate window (alt-F11) before you run it, so that the debug.print messages will be captured. Basically, if I have the calls right, this should give you a log of specific errors for each attempt.

    This is air code. Highly structured air code, though. If I made a mistake one place, the same mistake should be in every other place.

    I also put curly braces around the driver name. They were there on every web sample I found, so I put them in.

  8. #8
    techieanalyst is offline Novice
    Windows 8 Access 2010 32bit
    Join Date
    Jul 2013
    Posts
    16
    Another small update, so the table called AccountingSystems (You see it as a tbl above), if I switch all the other linked tables excluding this one, the problem doesn't occur, however the query goes back to being dead slow, if I only change that one entries link it seems to break, again its referenced in the above code

  9. #9
    techieanalyst is offline Novice
    Windows 8 Access 2010 32bit
    Join Date
    Jul 2013
    Posts
    16
    Thanks! Just tested it and it threw back an error 91 with

    'Exit if the connection exists and is already open
    If Nz(cn.State, ADODB.adStateClosed) <> ADODB.adStateClosed Then

    Under the debug

  10. #10
    Dal Jeanis is offline VIP
    Windows XP Access 2010 32bit
    Join Date
    May 2013
    Location
    Dallas TX
    Posts
    1,742
    You were probably typing when I posted that monster post #7...

  11. #11
    Dal Jeanis is offline VIP
    Windows XP Access 2010 32bit
    Join Date
    May 2013
    Location
    Dallas TX
    Posts
    1,742
    Okay, add back the define for bCreateConn AS Boolean, revert that section of code to this and continue-
    Code:
    If cn Is Nothing Then
            bCreateConn = True
        ElseIf cn.State = ADODB.adStateClosed Then
            bCreateConn = True
        Else
            bCreateConn = False
         Exit Sub
    End If
    Last edited by Dal Jeanis; 07-31-2013 at 02:13 PM. Reason: dim bcreateconn

  12. #12
    techieanalyst is offline Novice
    Windows 8 Access 2010 32bit
    Join Date
    Jul 2013
    Posts
    16
    Added it back in, when I click the button now it doesn't ask me for an entry and just shows the result page which is all pretty much blank data, when I go to close then window I get

    "The expresson On Close you entered as the event property settings produced the following error: Variable not defined"

  13. #13
    techieanalyst is offline Novice
    Windows 8 Access 2010 32bit
    Join Date
    Jul 2013
    Posts
    16
    Here's an extra update

    This setting: Set tbl = db.TableDefs("AccountingSystems")

    If I change the table to anything the query still works with no error, as long as that query doesn't have a DSN set, the second DSN is set via Linked Tables, it breaks and throws an error about no SQL Connection

    Seem to rely on connecting to the database via This setting: Set tbl = db.TableDefs("AccountingSystems")

  14. #14
    techieanalyst is offline Novice
    Windows 8 Access 2010 32bit
    Join Date
    Jul 2013
    Posts
    16
    Ok the Query that I believe that the button runs is this, and its the one that I believe is breaking:

    Private Sub Form_Load()
    Dim db As Object
    Dim qry As Object
    Dim rs As ADODB.Recordset
    Dim SQL As String
    Dim ProductGroup As String
    Set db = Application.CurrentDb
    Set qry = db.QueryDefs("ItemQtyStatusSQL")
    SQL = qry.SQL
    Set qry = Nothing
    Set db = Nothing
    ProductGroup = InputBox("Product Group", "Enter Parameter Value")
    If StrPtr(ProductGroup) = 0 Then
    DoCmd.Close acForm, Me.Name
    Else
    SQL = Replace(SQL, "[Product Group]", "'" & ProductGroup & "'", , , vbTextCompare)
    Set rs = New ADODB.Recordset
    rs.Open SQL, gcn, adOpenStatic, adLockReadOnly, adCmdText
    Set Me.Recordset = rs
    Set rs = Nothing
    End If
    End Sub

  15. #15
    Dal Jeanis is offline VIP
    Windows XP Access 2010 32bit
    Join Date
    May 2013
    Location
    Dallas TX
    Posts
    1,742
    So, when the form opens, it's deconstructing a stored query, replacing one field in that query with an entered parameter, and then loading that query as the form's recordset.

    It sure would seem safer and simpler to me to write the stored query to use a temporary or global variable, and set the temp or global variable beforehand instead, but that's an architecture call.

    I'd place a "debug.print SQL " line immediately before the line that says "Set rs = New ADODB.Recordset", and see if there's anything malformed about the SQL.

    The problem is, you have two different mysteries, and I can't tell when you're switching between sides.

    To debug, I'd take each step and nail down every aspect. For instance, take that tabledef, and debug.print all its properties. Then move on to the next thing.

    The first thing I'd track down is exactly where and when the global connection gcn gets created for the first time. To find this out, you might try starting up the database fresh, with a break in the initial screen, and put a watch on that gcn variable before allowing the app to continue.

    It sounds like there's some confusion inside the system with regard to creating gcn, but once it gets created, it is held for the remainder of the run. If that is correct, then getting that connection created behind the scenes up front would eliminate your issue.

Page 1 of 2 12 LastLast
Please reply to this thread with any new information or opinions.

Similar Threads

  1. Code Issue
    By pbaker in forum Programming
    Replies: 9
    Last Post: 08-07-2012, 07:57 AM
  2. Intermittant VBA Code Issue
    By eking002 in forum Forms
    Replies: 9
    Last Post: 07-10-2012, 02:20 PM
  3. connecting SQL code for a Query
    By Huddle in forum Queries
    Replies: 1
    Last Post: 02-08-2012, 03:42 PM
  4. Code issue on Format of label
    By Gavroche in forum Reports
    Replies: 2
    Last Post: 09-14-2011, 06:19 AM
  5. Form Code issue
    By Gavroche in forum Forms
    Replies: 2
    Last Post: 09-10-2011, 09:19 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums