I recently had to set up a new Linked Server on SQL Server 2012. It connects to a remote AS400 server using IBM iSeries OLE DB driver (IBM DB2 for I5/OS IBM DA400 Ole DB Provider)
Setting it up was no problem, except, whenever I ran a query, SQL Service would crash when the query finished returning results.
I found loads of good ideas (Switch of DEP, check for Heap Corruption, etc) but nothing worked. Finally I tried each parameter until it worked and got it working!!
To fix:
* Open Linked Servers -> Providers
* Right Click on ABMDA400, Properties
* Tick "Allow InProcess"
* Close the windows
BOOM - It works!!
From what I can gather, using it "out of process" protects SQL from errors on 64-bit machines,
Showing posts with label Zanoni. Show all posts
Showing posts with label Zanoni. Show all posts
Thursday, December 4, 2014
Friday, October 24, 2014
Changing the ID of a cube
So, we decided to do a checkpoint at work, and redeploy the production cubes from 8 months ago. That way, we can run both cubes, and show users what has been improved. however, when trying to deploy the SSAS project, it kept trying to deploy to the production cube. To solve it:
Pre-amble: Assume our cube Database is called JoeSoapSales.
I changed the name to JoeSoapSales_Feb2014 by renaming it, as well as changing it everywhere I could find in VS. Yet, when I deploy I get a message that the cube "JoeSoapSales" already exists.
Finally, thanks to a lot of googling, I found that, in the solution folder, there is a .database XML file ("JoeSoapSales.Database")... Just change the ID in there using your favourite text editor, and save... Sorted!!
Pre-amble: Assume our cube Database is called JoeSoapSales.
I changed the name to JoeSoapSales_Feb2014 by renaming it, as well as changing it everywhere I could find in VS. Yet, when I deploy I get a message that the cube "JoeSoapSales" already exists.
Finally, thanks to a lot of googling, I found that, in the solution folder, there is a .database XML file ("JoeSoapSales.Database")... Just change the ID in there using your favourite text editor, and save... Sorted!!
Labels:
Analysis services,
Deploy,
Labuschagne,
Overwrite,
Project,
SQL Server,
SSAS,
Zanoni
Monday, October 13, 2014
TimeXtender deployment still references old server
We use an ETL tool called TimeXtender (v2014), which is a SSIS wizard.
We recently had to migrate to a new server. After changing the connections via the front-end wizard, saving and deploying the solution, I had an interesting experience. No matter how many times I ran it, my data didn't change. But when I logged into the old server, I was shocked - all my production data had disappeared. Logic told me that TimeXtender had tried to run against my old server, not the new one.
I confirmed all my connections were pointing to the old server.
I approached the vendor, who reconfirmed the basics (did I save, run the wizard, etc... Which I did do).
Eventually, I exported the project to XML, and opened it in notepad... Lo and behold the SSIS server was still set to the old server. I did a quick find/Replace, and imported the project back in... I ran it, and it worked.
So, the vendor contacted me this morning. It turns out, that next to the Login credentials button, there is a "Advanced" button, which doesn't change the login properties, but mostly SSIS properties, including server name.
We recently had to migrate to a new server. After changing the connections via the front-end wizard, saving and deploying the solution, I had an interesting experience. No matter how many times I ran it, my data didn't change. But when I logged into the old server, I was shocked - all my production data had disappeared. Logic told me that TimeXtender had tried to run against my old server, not the new one.
I confirmed all my connections were pointing to the old server.
I approached the vendor, who reconfirmed the basics (did I save, run the wizard, etc... Which I did do).
Eventually, I exported the project to XML, and opened it in notepad... Lo and behold the SSIS server was still set to the old server. I did a quick find/Replace, and imported the project back in... I ran it, and it worked.
So, the vendor contacted me this morning. It turns out, that next to the Login credentials button, there is a "Advanced" button, which doesn't change the login properties, but mostly SSIS properties, including server name.
Labels:
2014,
Data not changing,
Labuschagne,
Problem,
ssis,
TimeXtender,
TX,
Zanoni
Access Denied to .Net folders when processing a SQL 2012 SSAS Cube
We recently migrated to a new server. The deployment went smooth, up unto the point where we had to process the cube. When trying to process, it failed immediately. The error was: "Errors in the high-level relational engine. The following exception occurred while an operation was being performed on a data source view: Configuration system failed to initialize;An error occurred loading a configuration file: Access to the path 'C:\Windows\Microsoft.NET\Framework64\v4.0.30319\Config\machine.config' is denied. (C:\Windows\Microsoft.NET\Framework64\v4.0.30319\Config\machine.config)
Access to the path 'C:\Windows\Microsoft.NET\Framework64\v4.0.30319\Config\machine.config' is denied.."
Access to path? Easy-peasy fix... except it wasn't. I added the service accounts to the admin groups, gave the folders explicit permissions, no joy. Suddenly I felt very silly - such a simple looking problem, and I can't get it sorted? Google yielded no help... So, out of desperation, I yielded to my AD Admin days, and thought what I would do then... So, to resolve:
Access to the path 'C:\Windows\Microsoft.NET\Framework64\v4.0.30319\Config\machine.config' is denied.."
Access to path? Easy-peasy fix... except it wasn't. I added the service accounts to the admin groups, gave the folders explicit permissions, no joy. Suddenly I felt very silly - such a simple looking problem, and I can't get it sorted? Google yielded no help... So, out of desperation, I yielded to my AD Admin days, and thought what I would do then... So, to resolve:
- Reset the permissions of the service accounts
- Added the service accounts to a group with the right permissions
- Changed the SQL and SSAS Service accounts to my own account
- Stop and restart the SQL & SSAS Services
- Changed the SQL and SSAS Service accounts back to the Service Accounts
- Stop and restart the SQL & SSAS Services
Voila, it worked :)
Labels:
.Net,
Access Denied,
Analysis services,
Cube,
Labuschagne,
Process,
SQL,
Zanoni
Saturday, October 26, 2013
Setting up POP3 and SMTP Relays with Exchange 2010
Wow, recently had SO much fun struggling with Exchange 2010, to set up a POP3 connectors for external mailboxes and an SMTP relay for an internal SQL mail server. The challenge was, that when I could relay internal mail to external, my POP mailboxes fell over, and vice versa...In the end, I had to delete all the connectors Exchange created by default, and set them up manually.
It all started when I was trying to send a SQL mail using CDO. I kept getting "-2147220977" error code, which translates into "0x8004020FL - The server rejected one or more recipient addresses" (Convert the code to hex, and look at TechNet for the meaning). When I rewrote my code to C# (.Net), it popped up with "5.7.1 Unable to relay". So, at this point, I was sure SMTP was the problem.
I deleted all the SMTP connectors, and recreated one for outgoing routing, and it worked... Or so I thought... even though the mail goes out, I now could not download any mail from POP3 mailboxes. When I started the POP3 download, Event log had an error event :"Cannot connect to the SMTP server 'localhost' on port 25. The error code was 0x800ccc0f. Verify that the Microsoft Exchange Transport service is running and that the Exchange receive connectors are properly configured"
Googling did not help much, as it seems not a lot of people have had this problem before, so out of desperation, I took to my trusty whiteboard, and designed what I wanted it to do (I know, such a developer thing to do, but hey, it worked). I came up with an action plan, executed it, and lo and behold, it worked.
This is what I did...
Now test, and there ya go... Hopefully this will make your searching simpler than what I had to go through to get it to work :)
It all started when I was trying to send a SQL mail using CDO. I kept getting "-2147220977" error code, which translates into "0x8004020FL - The server rejected one or more recipient addresses" (Convert the code to hex, and look at TechNet for the meaning). When I rewrote my code to C# (.Net), it popped up with "5.7.1 Unable to relay". So, at this point, I was sure SMTP was the problem.
I deleted all the SMTP connectors, and recreated one for outgoing routing, and it worked... Or so I thought... even though the mail goes out, I now could not download any mail from POP3 mailboxes. When I started the POP3 download, Event log had an error event :"Cannot connect to the SMTP server 'localhost' on port 25. The error code was 0x800ccc0f. Verify that the Microsoft Exchange Transport service is running and that the Exchange receive connectors are properly configured"
Googling did not help much, as it seems not a lot of people have had this problem before, so out of desperation, I took to my trusty whiteboard, and designed what I wanted it to do (I know, such a developer thing to do, but hey, it worked). I came up with an action plan, executed it, and lo and behold, it worked.
This is what I did...
- In the Exchange Management Console, go to Server Configuration, Hub Transport, and delete ALL receive connectors
Now let the fun start:
- Using the Wizard, Create a new Connector, called "POP3 Mailbox Connector". Set the intended use to "Custom" and click on next
- At Local Network Settings, remove the default, and add specific IP 127.0.0.1
. For the FQDN, use the FQDN of the Exchange server, and click on next - This will tell the server which server to send the incoming mail to. - At Remote Network Settings, remove the default, and add "127.0.0.1". This will tell the server which machine will be doing the POP3 pickups. Click on next, and run through the confirmation screens (New, Finish)
- Double click on the new connection
- Go to Authentication, and enable Basic Authentication only. This will allow the POP connector to send credentials to the remove POP mailbox server
- Click on Permission Groups, and set Anonymous Users and Exchange Servers. This will let the current server connect to the boxes, either through the NW Server account or through and Exchange account
- Click on Apply, and the POP3 component is set.
At this point the connection is set, but because of security not set, it can't do anything
Now for the SMTP relay
- Using the Wizard, Create a new Connector, called "SMTP Relay Connector". Set the intended use to "Custom" and click on next
- At Local Network Settings, remove the default, and add the specific IP address of the exchange server
for the FQDN, use the FQDN of the Exchange server, and click on next - This will tell the server which server to send the incoming mail to. - At Remote Network Settings, remove the default, and add the IP of the server you want to send emails from. Click on next, and run through the confirmation screens (New, Finish)
- Double click on the new connection
- Click on Permission Groups, and set Exchange Servers. This will let the current server allow connections from the sending server
- Go to Authentication, and enable Transport Layer Security (TLS) and Externally Secured. This will allow the server to receive the internally generated emails, and get the response from external domains
- Click on Apply, and the SMTP component is set.
At this point the connection is set, but because of security not set, it can't do anything
Now test, and there ya go... Hopefully this will make your searching simpler than what I had to go through to get it to work :)
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!!!
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
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
Labels:
2007,
Analysis services,
Cube,
excel,
Labuschagne,
pivot,
table,
VBA,
Zanoni
Subscribe to:
Posts (Atom)