Monday, February 1, 2010

SQL Error 18456 State 28000

Hi

I recently came accross a machine that had me confused... The connection from this machine to our production SQL server refused to work... here is what I tested:

Before I start, here are our actors:
* Machine A - The client that won't connect
* Machine B - My Dev machine
* SQL A - Our Production SQL server
* SQL B - Our dev server
* Login A - The login of the regular user of Machine A
* Login B - My admin login
* Profile A - The user's profile
* Profile B - my windows profile

So, to the test:
1. Profile A - Machine A to SQL A using Login A... Failed
2. Profile A - Machine A to SQL A using the "sa" account... Failed
3. Profile A - Machine A to SQL B... Works 100%
4. Profile B - Machine A to SQL A using Login A... Success
5. Profile B - Machine A to SQL A using the "sa" account... Failed
6. Profile B - Machine A to SQL B... Works 100%
7. Profile A - Machine B to SQL A using Login A... Works 100%
8. Profile A - Machine B to SQL A using the "sa" account... Works 100%
9. Profile A - Machine B to SQL B... Works 100%

So, the credentials are correct. It's only when you connect Machine A to SQL A that there is an error.

Lots of googling revealed a lot of people saying stuff like "Check your passwords"... NOT HELPFUL!!! At this point, if you hadn't checked the passwords, you deserve a kick in the patootie!!

So, I asked a DBA what he tought, and he suggested I check the SQL Network Client Configuration. There was an alias to the server... it was 100% correct (the right IP, and the right details), but I deleted it anyway...

LO AND BEHOLD, IT WORKED!!!

Go figure!!!

Friday, January 8, 2010

Building Excel 2007 Pivot Tables connected to cubes using VBA

Hi.

I recently embarked on the idea of building a pivot table connected to a cube. It seemed so simple !? Just build a MDX query, pass it to Excel, and voila!!! OOPS!!! Excel cannot take MDX queries. If you want to add rows, columns and measures, you have to do it it manually. And Then I started searching for the how to... Would you believe it... There are myriads of examples, and yet each one of them are only people who recorded a macro, then pasted the code. It helps to point you in the right direction, but I kept hitting stumpling blocks (as opposed to a stumbling block - a stumpling block is where you just don't know anymore... you are stumped).

So here is some code I developed. It builds the connection, clears the existing tables, and recreates a pivottable dynamically. The key though, is that I added 2 mods (AddFieldToTable and AddFilterToTable), that you just pass params to, and it will take care of the rest. Write once, use many times!!!

It may be easier to step through the code, than trying to explain it.

Please take a look at it,and comment if this helps...

Regards,

Zanoni...




Option Explicit
'An enum for the type of filter to be applied (one item or multiple items
Private Enum xlFilterType
SingleItemFilter = 0
MultipleItemFilter = 1
End Enum

'An enum to indicate if an item must be part of the list of visible items, or if it is an item to be removed
Private Enum xlFilterVisibility
Visible = 0
Hidden = 1
End Enum

'Collection to store the filter values
Private mColFilterFields As Collection

'An instance of an array for the values
Private MultipleFilterFields() As String


'==========================================================================================
'Main sub to build the Pivot Table
'==========================================================================================
'Date By Action
'==========================================================================================
'6 Jan 2010 Zanoni Labuschagne Created
'==========================================================================================
Public Sub GenerateResultSet()
On Error Resume Next
Dim strPartner, strYear, strScheme As String
Dim DestSheet As Excel.Worksheet
Dim DestRange As Excel.Range
Dim myPVT As Excel.PivotTable

'Set the sheet where the pivottable will be placed
Set DestSheet = ThisWorkbook.Worksheets("Sheet2")

'Set the range on the sheet where the pivottable will be placed
Set DestRange = DestSheet.Cells(10, 1)

Set mColFilterFields = New Collection

'Get the values for the filters
strPartner = DestSheet.Cells(1, 2).Value
strYear = DestSheet.Cells(2, 2).Value
strScheme = DestSheet.Cells(4, 2)

'Remove existing pivottables from the sheet
ClearExistingPivotTables DestSheet
DestRange.Select

'Build the connection to the cube
CreateConnection DestRange, "MyTable"

Set myPVT = DestSheet.PivotTables("MyTable")

'To make it look neater, hide the sheet while building
DestSheet.Visible = xlSheetHidden

'Hide the field list
ThisWorkbook.ShowPivotTableFieldList = False

'For performance, stop auto updating
myPVT.ManualUpdate = True

'Add the pivottable fields & filters
AddFieldToPivot myPVT, "Dimension Number1", "Attribute number 1", xlPageField
AddFilterToField myPVT, "Dimension Number1", "Attribute number 1", xlPageField, SingleItemFilter, "Some Value"

'Add another Dim Field
AddFieldToPivot myPVT, "Dimension Number 2", "Attribute number 2", xlPageField
AddFilterToField myPVT, "Dimension Number 2", "Attribute number 2", xlPageField, SingleItemFilter, "Some other Value"

'Add another Dim Field, and do a multiple filter
AddFieldToPivot myPVT, "Dimension Number 3", "Attribute number 3", xlRowField, True

'Hide e.g. the Unknown member
AddFilterToField myPVT, "Dimension Number 3", "Attribute number 3", xlRowField, MultipleItemFilter, "Unknown", Hidden

'Hide e.g. a blank member
AddFilterToField myPVT, "Dimension Number 3", "Attribute number 3", xlRowField, MultipleItemFilter, "", Hidden

'Hide e.g. SomeFunnyMember
AddFilterToField myPVT, "Dimension Number 3", "Attribute number 3", xlRowField, MultipleItemFilter, "SomeFunnyMember", Hidden

'Add some measures
AddFieldToPivot myPVT, "Measures", "[Measure 1]", xlDataField
AddFieldToPivot myPVT, "Measures", "[Measure 2]", xlDataField
AddFieldToPivot myPVT, "Measures", "[Measure 3]", xlDataField

'Update the table
myPVT.Update

'Show the sheet
DestSheet.Visible = xlSheetVisible

'Set the sheet focus
DestSheet.Select
End Sub


'==========================================================================================
'Adds a field to the PivotTable
'Parameters:
' PivotTableObject - A reference to the pivottable
' Dimension - Name of the dimension being added (For a measure, use "Measures"
' DimAttribute - Name of the attribute being added
' FieldType - Will the field be pleaced in the page area, Row, column, or value
' SuppressSubTotal - Must the subtotal be shown or hidden
'==========================================================================================
'Date By Action
'==========================================================================================
'6 Jan 2010 Zanoni Labuschagne Created
'==========================================================================================
Private Sub AddFieldToPivot(ByRef PivotTableObject As PivotTable, ByVal Dimension As String, ByVal DimAttribute As String, ByVal FieldType As XlPivotFieldOrientation, Optional ByVal SuppressSubTotal As Boolean)
On Error GoTo AddFieldError
Dim Hierarchy, FilterHierarchy As String

'Format and build the full hierarchy name
Dimension = "[" & Replace(Replace(Dimension, "]", ""), "[", "") & "]"
DimAttribute = "[" & Replace(Replace(DimAttribute, "]", ""), "[", "") & "]"
Hierarchy = Dimension & "." & DimAttribute
FilterHierarchy = Hierarchy & "." & DimAttribute


Select Case FieldType
'Add rows/Columns
Case xlColumnField, xlRowField
With PivotTableObject.CubeFields(Hierarchy)
.Orientation = FieldType
Select Case FieldType
Case xlColumnField
.Position = PivotTableObject.ColumnFields.Count + 1
Case xlRowField
.Position = PivotTableObject.RowFields.Count + 1
End Select
End With

If SuppressSubTotal Then
PivotTableObject.PivotFields(FilterHierarchy).Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
End If

'Add Page Fields
Case xlPageField
With PivotTableObject.CubeFields(Hierarchy)
.Orientation = xlPageField
.Position = PivotTableObject.PageFields.Count + 1
End With

'Add measures
Case xlDataField
PivotTableObject.AddDataField PivotTableObject.CubeFields(Hierarchy)
End Select
Exit Sub

AddFieldError:
Select Case Err.Number
Case 9
MsgBox "Could not find the attribute " & DimAttribute & ".", vbCritical + vbOKOnly
Exit Sub
Case Else
MsgBox Err.Description, vbCritical + vbOKOnly
Resume Next
End Select
End Sub

'==========================================================================================
'Adds a filter to the PivotTable
'Parameters:
' PivotTableObject - A reference to the pivottable
' Dimension - Name of the dimension being added (For a measure, use "Measures"
' DimAttribute - Name of the attribute being added
' FieldType - Will the field be pleaced in the page area, Row, column, or value
' FilterType - is it one item, or multiple items
' Style - Must the filter remove an item from a full list, or add it to an emplty list
'==========================================================================================
'Date By Action
'==========================================================================================
'6 Jan 2010 Zanoni Labuschagne Created
'==========================================================================================

Private Sub AddFilterToField(ByRef PivotTableObject As PivotTable, ByVal Dimension As String, ByVal DimAttribute As String, ByVal FieldType As XlPivotFieldOrientation, ByVal FilterType As xlFilterType, ByVal FilterValue As String, Optional Style As xlFilterVisibility)
On Error GoTo AddFilterError
Dim Hierarchy, FilterHierarchy, FilterMember As String
Dim MultiFilterList() As String
'Format and build the full hierarchy name
Dimension = "[" & Replace(Replace(Dimension, "]", ""), "[", "") & "]"
DimAttribute = "[" & Replace(Replace(DimAttribute, "]", ""), "[", "") & "]"
Hierarchy = Dimension & "." & DimAttribute
FilterHierarchy = Hierarchy & "." & DimAttribute
FilterMember = Hierarchy & ".&[" & FilterValue & "]"

Select Case FilterType
Case SingleItemFilter
PivotTableObject.CubeFields(Hierarchy).EnableMultiplePageItems = False
PivotTableObject.PivotFields(FilterHierarchy).CurrentPageName = FilterMember

Case MultipleItemFilter
PivotTableObject.CubeFields(Hierarchy).EnableMultiplePageItems = True

MultipleFilterFields = GetFieldArrayFromCollection(Hierarchy)
ReDim Preserve MultipleFilterFields(UBound(MultipleFilterFields) + 1)
MultipleFilterFields(UBound(MultipleFilterFields)) = FilterMember
If Style = Visible Then
PivotTableObject.CubeFields(Hierarchy).IncludeNewItemsInFilter = False
PivotTableObject.CubeFields(Hierarchy).PivotFields(FilterHierarchy).VisibleItemsList = MultipleFilterFields
Else
PivotTableObject.CubeFields(Hierarchy).IncludeNewItemsInFilter = True
PivotTableObject.CubeFields(Hierarchy).PivotFields(FilterHierarchy).HiddenItemsList = MultipleFilterFields
End If
WriteFieldArrayToCollection Hierarchy, MultipleFilterFields()
End Select

Exit Sub

AddFilterError:
Select Case Err.Number
Case 9 ' Array not yet initialised
ReDim MultipleFilterFields(0)
Resume
Case Else
MsgBox "Could not add a filter to " & Dimension & " for value " & FilterMember & Chr(13) & Chr(13) & Err.Description, vbCritical + vbOKOnly
Exit Sub
End Select

End Sub

'==========================================================================================
'Creates the Excel Connection to the Cube
'Parameters:
' DestinationRange - The Excel Range where the cube must be placed
' TableName - The reference name you want to give the pivottable
'==========================================================================================
'Date By Action
'==========================================================================================
'6 Jan 2010 Zanoni Labuschagne Created
'==========================================================================================
Private Sub CreateConnection(ByRef DestinationRange As Range, ByVal TableName As String)
On Error Resume Next
'TODO: Add Variables instead of hardcoding
Dim ConnectionName, ConnectionString, ConnectionCommand As String

ConnectionName = "MyConnection"
ConnectionString = "OLEDB;Provider=MSOLAP.4;Integrated Security=SSPI;Persist Security Info=True;Data Source=YourServerName;Initial Catalog=YourASDatabase"
ConnectionCommand = "YourDefaultCube"

ThisWorkbook.Connections(ConnectionName).Delete
ThisWorkbook.Connections.Add ConnectionName, "Connection used to connect to HIP DW GP Cube", ConnectionString, ConnectionCommand, 1

ThisWorkbook.PivotCaches.Create(xlExternal, ThisWorkbook.Connections(ConnectionName), xlPivotTableVersion12).CreatePivotTable DestinationRange, TableName, xlPivotTableVersion12

End Sub
'==========================================================================================
'Clears all Pivot tables from the sheet
'Parameters:
' MySheet - The reference to the sheet to clear
'======================================e====================================================
'Date By Action
'==========================================================================================
'6 Jan 2010 Zanoni Labuschagne Created
'==========================================================================================
Private Sub ClearExistingPivotTables(ByRef mySheet As Worksheet)
Dim myPVT As PivotTable

For Each myPVT In mySheet.PivotTables
myPVT.PivotSelect "", xlDataAndLabel, True
Selection.ClearContents
Next myPVT
End Sub
'==========================================================================================
'Gets an array of filter fields from a collection
'Parameters:
' Hierarchy - The key to the item to be retrieved
'======================================e====================================================
'Date By Action
'==========================================================================================
'6 Jan 2010 Zanoni Labuschagne Created
'==========================================================================================
Private Function GetFieldArrayFromCollection(ByVal Hierarchy As String) As String()
On Error Resume Next
GetFieldArrayFromCollection = mColFilterFields(Hierarchy)
End Function


'==========================================================================================
'Writes an array of filter fields into a collection
'Parameters:
' Hierarchy - The key to the item to be retrieved
' FieldArray - The updated array to be written back into the collection
'======================================e====================================================
'Date By Action
'==========================================================================================
'6 Jan 2010 Zanoni Labuschagne Created
'==========================================================================================
Private Sub WriteFieldArrayToCollection(ByVal Hierarchy As String, FieldArray() As String)
On Error Resume Next
mColFilterFields.Remove Hierarchy
mColFilterFields.Add FieldArray(), Hierarchy
End Sub