Hi Matt,
Thanks for this and I can see what you're doing with the stored procedure.
Maybe I'm missing it, but still don't get the purpose or function of the
query table though - no matter.
I'm also assuming that its not possible or feasible to modify the stored
procedure T-SQL statement on the server to return the additional, calculated
column(s) your after into the original recordset. (e.g. SELECT fieldA,
fieldB, fieldA*fieldB FROM relevant_table WHERE ...). If so, or if you or
your DBA can create another Stored Proc to return ALL the columns that you
require, that would be easier and preferable (IMO).
Nonetheless, I include below some 'quick and dirty' code that will retrieve
the results of a SQL Server parameterized stored procedure into a recordset,
display that recordset on an Excel worksheet and then fill some additional
columns in that row range with formulae of your choosing.
Like I say, the purists amongst us might not describe the code as 'elegant',
but hey, it works and has worked for me <g.
Let me know how you get on or if you need anything else.
Enjoy and HTH, Sean.
----------
Sub OpenSQLCnn()
Dim SQLCnn As ADODB.Connection
Dim SQLCmd As ADODB.Command
Dim SQLRst As ADODB.Recordset
Dim prm(2) As ADODB.Parameter
Dim strCnn As String, strSQL As String
Dim iCol As Integer, fldCount As Integer
strCnn = Empty
strCnn = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security
Info=True;" & _
"Initial Catalog=Northwind;Data Source=localhost"
strSQL = Empty
' This stored procedure is in the SQL Server 2000 Northwind dB.
' It takes 2 parameters (@Beginning_Date and @Ending_Date) and returns
6 fields.
strSQL = strSQL & "dbo.[Employee Sales by Country]"
Set SQLCnn = New ADODB.Connection
Set SQLCmd = New ADODB.Command
Application.StatusBar = "Connecting ..."
With SQLCnn
.CursorLocation = adUseClient
.Open strCnn
End With
With SQLCmd
.ActiveConnection = SQLCnn
.CommandText = strSQL
.CommandType = adCmdStoredProc
Set prm(1) = .CreateParameter("Beginning_Date", adDate, adParamInput)
' Of course, parameter values could be passed to the subroutine or
retrieved from user at run-time.
prm(1).Value = "June 1, 1997"
Set prm(2) = .CreateParameter("Ending_Date", adDate, adParamInput)
prm(2).Value = "June 30, 1997"
For i = 1 To UBound(prm)
.Parameters.Append prm(i)
Next i
End With
Application.StatusBar = "Executing ..."
Set SQLRst = SQLCmd.Execute
ThisWorkbook.Worksheets("Sheet1").Activate
With ThisWorkbook.Worksheets("Sheet1")
.Activate
.UsedRange.EntireColumn.Delete
Application.StatusBar = "Populating ..."
fldCount = SQLRst.Fields.Count
For iCol = 1 To fldCount
.Cells(1, iCol).Value = SQLRst.Fields(iCol - 1).Name
Next
.Cells(2, 1).CopyFromRecordset SQLRst
Application.StatusBar = "Formatting ..."
.Rows(1).Font.Bold = True
.Cells(1, 1).Activate
' Fill down the formulae ...
Application.StatusBar = "Filling Formulae ..."
FillRangeWithFormulae
.UsedRange.Columns.AutoFit
.Cells(1, 1).Activate
End With
Application.StatusBar = "Closing ..."
SQLRst.Close
SQLCnn.Close
Set SQLRst = Nothing
Set SQLCmd = Nothing
Set SQLCnn = Nothing
Application.StatusBar = False
End Sub
Sub FillRangeWithFormulae()
' Insert a formula in the next blank cell to the right of the CurrentRegion
With ActiveCell.CurrentRegion.Resize(1, 1).Offset(1,
ActiveCell.CurrentRegion.Columns.Count)
' Assuming there's a heading row, add a heading for the new column
(or get it from the user)
.Offset(-1, 0).Value = "Commission (%)"
' Insert your required formula . Here's an example ...
.Formula = "=IF(" & .Offset(0, 1 -
ActiveCell.CurrentRegion.Columns.Count).Address(Ro wAbsolute:=False) &
"=""USA"",4%,5%)"
.Copy ' Copy this cell
' and then paste (fill) the formula down all the rows in this column
.Resize(ActiveCell.CurrentRegion.Rows.Count - 1, 1).PasteSpecial
(xlPasteFormulas)
End With
Application.CutCopyMode = False
' And once again using the formula we just filled. (It's not necessary
- just to demonstrate).
With ActiveCell.CurrentRegion.Resize(1, 1).Offset(1,
ActiveCell.CurrentRegion.Columns.Count)
.Offset(-1, 0).Value = "Commission ($)"
.Formula = "=" & .Offset(0, -1).Address(RowAbsolute:=False) & "*" &
..Offset(0, -2).Address(RowAbsolute:=False)
.Copy
.Resize(ActiveCell.CurrentRegion.Rows.Count - 1, 1).PasteSpecial
(xlPasteFormulas)
End With
Application.CutCopyMode = False
End Sub
"MattShoreson" wrote:
I am using both.
The reason for this is the ability for a querytable to automatically
fill down adjacent columns formulae.
1) So my steps are retrieve sproc to recordset via ado.
2) Recordset to excel worksheet.
3) Querytable based on date returned in step 2.
Code is as follows:
Sub Main(ByVal strXLQT As String, ByVal strDateFrom As String, ByVal
strDateTo As String)
Dim xlTDBook As Excel.Workbook
Dim xlRDBook As Excel.Workbook
Dim strQT As String
Sheets(cstr_SOURCE).Select
Sheets(cstr_SOURCE).Range("MFTPData").ClearContent s
FireSP strDateFrom, strDateTo
strQT = strXLQT
Sheets(cstr_DATA).Select
Application.Calculation = xlCalculationManual
Workbooks.Open Filename:=cstr_PATH & "RD.xls", UpdateLinks:=0
Workbooks("TD.xls").Activate
Range("QT_MFTP").QueryTable.Refresh BackgroundQuery:=False
Application.Calculation = xlCalculationAutomatic
Workbooks("RD.xls").Close True
Range("MFTPData").ClearContents
End Sub
Sub FireSP(ByVal strDateFrom As String, ByVal strDateTo As String)
Dim vParams As Variant
Dim vValues As Variant
Dim rsReturn As ADODB.Recordset
vParams = Array("datef", "datet")
vValues = Array(strDateFrom, strDateTo)
ReturnRSFromSP "sph_brkr_dscl", vParams, vValues
End Sub
Public Sub ReturnRSFromSP(strSP As String, vParams As Variant, vValues
As Variant)
Dim cnSP As ADODB.Connection
Dim cmdSP As ADODB.Command
Dim lCounter As Long
Dim strItem As String
Dim lIndex As Long
Dim rsReturn As ADODB.Recordset
Set cnSP = New ADODB.Connection
cnSP.ConnectionString =
"Provider=MSDASQL.1;Database=DBaseName;Password=PW D1;Persist Security
Info=True;" & _
"User ID=UID1;Data Source=Dbase1"
cnSP.Open
Set cmdSP = New ADODB.Command
cmdSP.ActiveConnection = cnSP
cmdSP.CommandText = strSP
cmdSP.CommandType = adCmdStoredProc
cmdSP.Parameters.Refresh
lCounter = 0
For lCounter = 1 To cmdSP.Parameters.Count - 1
strItem = cmdSP.Parameters(lCounter).Name
For lIndex = 0 To UBound(vParams)
If "@" & vParams(lIndex) = strItem Then
cmdSP.Parameters(lCounter).Value = vValues(lIndex)
Exit For
End If
Next
Next
Set rsReturn = New ADODB.Recordset
With rsReturn
.CursorLocation = adUseClient
.CursorType = adOpenDynamic
.LockType = adLockBatchOptimistic
.Open cmdSP
End With
Do Until rsReturn Is Nothing
If rsReturn.State = adStateOpen Then
DumpRecordset rsReturn
End If
Set rsReturn = rsReturn.NextRecordset
Loop
Set cmdSP = Nothing
If cnSP.State = adStateOpen Then
cnSP.Close
End If
Set cnSP = Nothing
Set rsReturn = Nothing
End Sub
Sub DumpRecordset(rsName As ADODB.Recordset, Optional lstartpos As
Long)
Dim W As Workbook
Dim nField As Integer
Dim lRowPos As Long
With rsName
For nField = 1 To .Fields.Count
Cells(1, nField).Value = .Fields(nField - 1).Name
Next nField
If .RecordCount = 0 Then
Exit Sub
End If
.MoveFirst
If Not IsEmpty(lstartpos) Then
.Move lstartpos
End If
End With
Sheets(cstr_SOURCE).Cells(2, 1).CopyFromRecordset rsName
End Sub
--
MattShoreson
------------------------------------------------------------------------
MattShoreson's Profile: http://www.excelforum.com/member.php...fo&userid=3472
View this thread: http://www.excelforum.com/showthread...hreadid=384301