Excel SQL Asynchronous Queries

[Biz]

Dear All,

How can I run Asynchronous Queries where you don't have to wait for results of one queries to be fully executed before next query ie executed?

Code below works for synchronously query where you have to wait for it to finish before moving on to another task.

Sub a_MultipleAsyncRuns()
    '
    ' FOR THIS CODE TO WORK
    ' In VBE you need to go Tools References and check Microsoft Active X Data Objects 2.x library
    '
    
    Dim CN As ADODB.Connection
    Dim Server_Name As String
    Dim Database_Name As String
    Dim ws As Worksheet
    Dim User_ID As String
    Dim Password As String
    Dim SQLStr As String
    Dim RS As ADODB.Recordset
    Dim i As Long, j As Long
    Dim SqlTextFile
    Dim Connected As Boolean
    Dim aVariables As Variant
    Dim msgUser As String
    Dim sDirectory As String
    
    
    'Variables
    Const CTOut = 0 '<--- Change ConnectionTimeOut as Required
    aVariables = Range("Prod_View").Value '<--- Change as required which Server & DB to connect to
    sDirectory = Range("sDirectory")
    
    'Dim aStartTime
    aStartTime = Now()
    
    'Speeding Up VBA Code
    Call SpeedOn
    
    'Get DB Details
    For j = LBound(aVariables) To UBound(aVariables)
        
        'Load SQL Script
        SqlTextFile = sDirectory & "\" & aVariables(j, 4) 'Enter your SQL location
        Debug.Print SqlTextFile
        Dim hFile As Long
        hFile = FreeFile
        Open SqlTextFile For Input As #hFile
        SQLStr = Input$(LOF(hFile), hFile)
        Close #hFile
        Debug.Print SQLStr
        
        
        Server_Name = aVariables(j, 1)
        Database_Name = aVariables(j, 2)
        Set ws = Sheets(aVariables(j, 3))
        
        If Server_Name <> "" Then
            
            User_ID = "" ' enter your user ID here
            Password = "" ' Enter your password here
            
            'Create Connection
            Set CN = New ADODB.Connection
            CN.CommandTimeout = CTOut ' ConnectionTimeOut
            'CN.ConnectionTimeOut = CTOut ' ConnectionTimeOut
            
            On Error Resume Next
            CN.Open "Driver={SQL Server};Server=" & Server_Name & ";Database=" & Database_Name & _
                ";Uid=" & User_ID & ";Pwd=" & Password & ";"
            On Error GoTo 0
            
            Set RS = New ADODB.Recordset
            
            'SET NOCOUNT ON - to create, add, query from SQL temp tables
            On Error Resume Next
            RS.Open "SET NOCOUNT ON " & SQLStr, CN, adOpenStatic
            On Error GoTo 0
            
            ' Check connection state
            If CN.State = 0 Then
                msgUser = "Couldn't connect to:" & vbNewLine & "Server=" & Server_Name & ";" & vbNewLine & "Database=" _
                    & Database_Name & ""
                MsgBox msgUser, vbCritical + vbOKOnly
                GoTo Skip
                ' Couldn't connect
                ' MsgBox "Could Not Connect!"
            Else
                
                'MsgBox "Connected!"
            End If
            
            'Clearcontents of Spreadsheet
            With ws
                .Activate
                .Range("A1:Z" & Range("A" & Rows.Count).End(xlUp).Row).ClearContents
            End With
            
            'Get Header
            For i = 0 To RS.Fields.Count - 1
                ws.Cells(1, i + 1) = RS.Fields(i).Name
            Next i
            
            ' Dump to spreadsheet
            With ws.Range("A2") ' Enter your sheet name and range here
                '.ClearContents
                .CopyFromRecordset RS
            End With
            
            '            'Convert Column cells "Number saved as Text" to Number Format
            '            Convert2NumbersSavedAsText ("assmnumber")
            
            ' Tidy up
            RS.Close
            Set RS = Nothing
            CN.Close
            Set CN = Nothing
            Set ws = Nothing
            
Skip:
            
        End If
        
    Next j
    
    'Teleport To Parameters Worksheet
    Sheets("Parameter").Activate
    
    'Define Range Names as per worksheet name
    Call CreateNamedRange
    
    'Speeding Up VBA Code
    Call SpeedOff
    
    'MsgBox "Time taken: " & " Sync took " & Format(Now() - aStartTime, "h:mm:ss")
       
End Sub

Your help would be greatly appreciated.</SPAN>

Kind Regards


Biz