Public Sub NetworkCrossCheck()
Dim rsReport As New ADODB.Recordset
Dim cnReport As New ADODB.Connection
Dim cmdReport As New ADODB.Command
Dim lrow As Long
Dim lCol As Long
Dim pc As PivotCache
Dim pt As PivotTable
Dim wb As Workbook
On Error GoTo NetworkCrossCheckError
cnReport.ConnectionString = "DSN=CM_Mod3SQL_DEV;"
cnReport.CursorLocation = adUseClient
cnReport.Open
If (cnReport.State <> adStateOpen) Then
MsgBox "Database connection not open, cannot run
query"
Exit Sub
End If
Set cmdReport.ActiveConnection = cnReport
cmdReport.CommandText = "rpt_NetworkCrossCheck_sp"
cmdReport.CommandType = adCmdStoredProc
cmdReport.CommandTimeout = 300
Set rsReport = cmdReport.Execute
Set wb = Workbooks.Open(sPath
& "NetworkCrossCheck_template.xls", 0, True)
Set pc = ActiveWorkbook.PivotCaches.Add
(SourceType:=xlExternal)
Set pc.Recordset = rsReport
pc.CreatePivotTable TableDestination:=Range("A3"),
TableName:="Network Cross Check"
With ActiveSheet.PivotTables("Network Cross Check")
.SmallGrid = False
.RowGrand = False
.ColumnGrand = False
With .PivotFields("NetworkName")
.Orientation = xlRowField
.Position = 1
End With
With .PivotFields("NetworkName1")
.Orientation = xlColumnField
.Position = 1
End With
With .PivotFields("TaxID")
.Orientation = xlDataField
.Position = 1
End With
End With
Set rsReport = Nothing
Set cmdReport = Nothing
Set cnReport = Nothing
Set wb = Nothing
'cnReport.Close
Exit Sub
NetworkCrossCheckError:
MsgBox CStr(Err.Number) & ": " & Err.Description &
vbCrLf & "Please call support",
vbExclamation, "NetworkCrossCheck"
Resume Next
End Sub
