Run-Time error '-2147217871 (80040e31)': Query timeout expired

Question

This error comes up when I try and run this big query. Smaller query's it doesn't. I have set connect timeout to 0 and that doesn't help. It looks like the connect makes it and it gets hung up at the .Open part of the code. Thank you for any help.

Public Sub dbConnectTDaY()
    Dim cn As ADODB.Connection
    Dim Rec_set As ADODB.Recordset
    Dim MyConn, varSQL As String
    Dim Rw As Long, Col As Long, c As Long
    Dim MyField, Location As Range
    Dim i As Integer

    Dim strSQL As String
    Dim strStDt As String
    Dim strEnDt As String
    strStDt = ThisWorkbook.Worksheets("xxx").Range("B6").Value
    strEnDt = ThisWorkbook.Worksheets("xxx").Range("B5").Value
    Set cn = New ADODB.Connection
    Set Rec_set = New ADODB.Recordset
    Set Location = [A2]
        Rw = Location.Row
        Col = Location.Column
        c = Col

    strSQL = ""
    strSQL = strSQL & "SELECT gp.cnt"
    strSQL = strSQL & ",gp.pod"
    strSQL = strSQL & ",gp.grp_paddsa"
    strSQL = strSQL & ",gp.grp_rasdd"
   '  etc.........



    cn.ConnectionTimeout = 0 'To wait till the query finishes without generating error

    cn.Open "DSN=#EDWP;Databasename=INTY;Uid=XXXXX;Pwd=XXXXX;"


    If cn.State = adStateOpen Then 'If connection is success, continue 'Check for errors...

        Rec_set.Open strSQL, cn 'Issue SQL statement
        For i = 0 To Rec_set.Fields.Count - 1
                ActiveSheet.Cells(1, i + 1) = Rec_set.Fields(i).Name
        Next i
        Do Until Rec_set.EOF
            For Each MyField In Rec_set.Fields
                Cells(Rw, c) = MyField
                c = c + 1
            Next MyField
            Rec_set.MoveNext
            Rw = Rw + 1
            c = Col
        Loop
    End If
     Rec_set.Close
    cn.Close

End Sub

Answer 1

cn.ConnectionTimeout = 0 only effects the timeout on the connection.

You want to set the CommandTimeout also.