silentbuddha
Board Regular
- Joined
- Mar 1, 2008
- Messages
- 112
Hi,
I have successfully created an ADO connection to SQL Server 2005. In my connection I am executing a stroed procedure. however, when I do my first test run...excel seesm to take forever completing my subroutine. What I also noticed from taskmanager is that my CPU usage jumps from 1-2 % to over 50% and it stays that way. I usually end up using task manager to close the process because I know it takes too long. I have provided my code below...would someone be able to tell me where my code is not efficient ??? here is a summary of how the subroutine works
1 - connection to ADO is created
2 - ADO connects to SQL Server 2005
3 - ADO execute my connection string
4 - results are place in a worksheet
5 - a pivot table is created using data from the worksheet
6 - close the ADO connection
************************ CODE ***********************
I have successfully created an ADO connection to SQL Server 2005. In my connection I am executing a stroed procedure. however, when I do my first test run...excel seesm to take forever completing my subroutine. What I also noticed from taskmanager is that my CPU usage jumps from 1-2 % to over 50% and it stays that way. I usually end up using task manager to close the process because I know it takes too long. I have provided my code below...would someone be able to tell me where my code is not efficient ??? here is a summary of how the subroutine works
1 - connection to ADO is created
2 - ADO connects to SQL Server 2005
3 - ADO execute my connection string
4 - results are place in a worksheet
5 - a pivot table is created using data from the worksheet
6 - close the ADO connection
************************ CODE ***********************
Code:
Private Sub getDtcDetails(date1 As String, date2 As String)
'This was set up using Microsoft ActiveX Data Components version 2.8
'this procedure will use the data on current worksheet to create pivot table
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim fld As ADODB.Field
Dim strSQL As String
Dim wb As Workbook
Dim ws As Worksheet
Dim rangeStart As Range
Dim pvtTable As PivotTable
Dim pvtField As PivotField
Dim objPvtCache As PivotCache
Dim iCol As Integer
Dim i As Integer
Const CONN_STRING As String = "Provider=SQLNCLI;Server=sql.XYZreporting;Database=isol_reporting;Trusted_Connection=yes;HDR=yes"";"
Set wb = ActiveWorkbook
Set ws = wb.Worksheets("DTC")
With ws
.Cells.Clear
.Cells.ClearContents
.Cells.ClearFormats
Set rangeStart = .Range("A2")
End With
'Set the sql string
strSQL = "exec Prg_Sales_DTC_Generate_Sales_Report " & _
"@dt_from='" & date1 & "', " & _
"@dt_to='" & date2 & "', " & _
"@showweek=1, " & _
"@group_ids='1;4;5;6;7;8;15', " & _
"@target_type=1, " & _
"@metric_ids='-32768;-32744;-32759;-32758;-32757'"
'Create the ADO connection object
Set conn = New ADODB.Connection
'Apply some settings to the ADO connection object
'Open the connection to the database : .Open CONN_STRING
'Store the result in rs recordset object : Set rs = .Execute(strSQL)
With conn
.CursorLocation = adUseClient
.Open CONN_STRING
.CommandTimeout = 0
Set rs = .Execute(strSQL)
End With
'Apply the rs fieldnames ( column headers ) into Worksheets("DTC")
iCol = 1
For Each fld In rs.Fields
'MsgBox "column # " & iCol & " fieldname is : " & fld.Name
ws.Cells(1, iCol).Value = fld.Name
iCol = iCol + 1
Next
'Paste the dataportion of the recordset into Worksheets("DTC")
rangeStart.CopyFromRecordset rs
'Correct cell with values stored as text on the Worksheets("DTC")
With ws.UsedRange
.Value = .Value
End With
'Initiate PivotCache object to accept external data
'since the data that we are using to feed the objPvtCache is from the current activeworksheet, the SourceType must be "xlDatabase"
Set objPvtCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=ws.UsedRange)
'Assign the objPvtCache to pvtTable object and create the pivot table
Set pvtTable = objPvtCache.CreatePivotTable(TableDestination:=ws.Range("Z10"), TableName:="DTC")
With pvtTable
For Each pvtField In .PivotFields
If pvtField.Name = "Week Date" Then
'MsgBox "the first pivot field is " & pvtField.Name
pvtField.Orientation = xlColumnField
pvtField.Position = 1
ElseIf pvtField.Name = "Group_Desc" Then
'MsgBox "the first pivot field is " & pvtField.Name
pvtField.Orientation = xlRowField
pvtField.Position = 1
Else
.AddDataField pvtField
End If
Next
End With
'This command changes the formatting of any field that appears in the Values area
For Each pvtField In pvtTable.DataFields
pvtField.Function = xlSum
Next pvtField
'cleanup and close connection
rs.Close
conn.Close
Set rs = Nothing
Set conn = Nothing
Set fld = Nothing
Set rangeStart = Nothing
Set objPvtCache = Nothing
End Sub
Last edited:
