Running SQL Stored Proc through VBA

[TedMosby]

I have this code below that only runs a Stored Procedure in SQL Server, for some reason it keeps timing out and I dont understand why.
When running the Stored Proc in SQL Server its fine.

Option Explicit
Dim cnnDW As ADODB.Connection
Dim rsDW As ADODB.Recordset
Dim stProcName As String
Dim strSQLServer As String
Sub BuildUpdateData()
        strSQLServer = "Driver={SQL Native Client};" & _
       "Server=CISSQL1;" & _
       "Database=CORPINFO;" & _
       "Trusted_Connection=Yes"
    Set cnnDW = New ADODB.Connection
    Application.ScreenUpdating = False
    cnnDW.Open strSQLServer
'Lkup_Update All Specialty with Lookup Table to help run ShowResults(C1B, C2B & C3B)
    Set rsDW = New ADODB.Recordset
    stProcName = "EXEC sp_PARA_UpdateLkUp"
    rsDW.CursorLocation = adUseClient
    rsDW.Open stProcName, cnnDW, adOpenDynamic, adLockOptimistic, adCmdText
    Application.ScreenUpdating = False
    cnnDW.Close
    Set cnnDW = Nothing
    Exit Sub
End Sub

Where have I gone wrong?

[Kenneth Hobs]

I don't use sqlserver but this QueryTables method might give you an idea.
[VBA]Sub Test()
Dim mdbPath As String, dbName As String, cmdText As String
Dim rngDestination As String
'mdbPath = "E:\ADO\NWind2003.mdb" 'change the path here to suit your needs
'mdbPath = "c:\myfiles\edrive\excel\ado\NWind2003.mdb"
mdbPath = "//matpc10/ExcelVBAExamples/ado/NWind2003.mdb"
dbName = "NWind2003_1" 'change the database name here to suit your needs
cmdText = "Aug94" 'change the stored SQL here to suit your needs
rngDestination = "A1" 'change the destination range here to suit your needs

'Clear previous data
Cells.Delete

InsertTableWithStoredSQL mdbPath, dbName, cmdText, rngDestination

'Insert other data to the right of A1 with a blank column separating the two
rngDestination = Cells(1, Columns.Count).End(xlToLeft).Offset(0, 2).Address
cmdText = "Sales by Category"
InsertTableWithStoredSQL mdbPath, dbName, cmdText, rngDestination
End Sub

Sub InsertTableWithStoredSQL(mdbPath As String, dbName As String, _
cmdText As String, rngDestination As String, _
Optional bFieldNames = True)

With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=" & mdbPath & ";Mode=ReadWrite;Extended Properties=""" _
, """;Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDBatabase Password="""";Jet OLEDB:Engine Type=5;Jet OLEDBatab" _
, "ase Locking Mode=1;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="""";J" _
, "et OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDBon't Copy Locale on Compact=False;Jet OLEDB:Co" _
, "mpact Without Replica Repair=False;Jet OLEDB:SFP=False"), Destination:=Range("" & rngDestination & ""))
.CommandType = xlCmdTable
.CommandText = Array(cmdText)
.Name = dbName
.FieldNames = bFieldNames
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = mdbPath
.Refresh BackgroundQuery:=False
End With
End Sub

[/VBA]