'********************************************************
' FUNCTION: fnBuildPivot()
'
' PURPOSE: Builds an Excel file then adds a pivot and connects to
' the CSV file OR Access database file parsed in. The xls
' file is saved in the same directory as the data file.
'
' ARGUMENTS:
' sourceDir: The directory of the source CSV file which
' the pivot will be built on
'
' sourceFile: File name of the CSV.
'
' RETURNS:
' String: Path of Pivot File.
'
'********************************************************
Public Function fnBuildPivot(sourceDir As String, sourceFile As String, FileType As ExportFileType) As String
On Error GoTo PROC_ERR
Dim xl As Excel.Application, wb As Excel.Workbook, ws As Excel.Worksheet, pc As Excel.PivotCache, FileNameLessXtn As String
Dim sFile As String, sDir As String, cmdText As String
Select Case FileType
Case CSV
FileNameLessXtn = Left(sourceFile, InStrRev(sourceFile, ".csv") - 1)
Case Access2003
FileNameLessXtn = Left(sourceFile, InStrRev(sourceFile, ".mdb") - 1)
' Case Access2007
' FileNameLessXtn = Left(sourceFile, InStrRev(sourceFile, ".accdb") - 1)
End Select
Set xl = New Excel.Application
Set wb = xl.Workbooks.Add
wb.SaveAs sourceDir & "\" & FileNameLessXtn & "_pivot.xls", xlWorkbookNormal
Set ws = wb.Worksheets("Sheet1")
ws.Name = "Pivot"
wb.Worksheets("Sheet2").Delete
wb.Worksheets("Sheet3").Delete
ws.Activate
Set pc = wb.PivotCaches.Add(SourceType:=xlExternal)
With pc
Select Case FileType
Case CSV
.Connection = Array(Array("ODBC;DBQ=" & sourceDir & ";"), Array("Driver={Microsoft Text Driver (*.txt; *.csv)};DriverId=27;Extensions=txt,csv,tab,asc;FIL=text;MaxBufferSize=2048;MaxScanRows=25;PageTimeout=50;SafeTransactions=0;Threads=3;UserCommitSync=Yes;"))
.CommandType = xlCmdSql
cmdText = "SELECT * FROM [" & sourceFile & "]"
Case Access2003
' .Connection = "ODBC;DSN=MS Access Database;DBQ=C:\Temp\VP_Work\ERA\ExportData.mdb;DefaultDir=C:\Temp\VP_Work\ERA;DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;"
' .CommandType = xlCmdSql
' .CommandText = Array( _
' "SELECT Data.YearMonth, Data.IssCountry, Data.FeeDesc, Data.FeeTier, Data.Member, Data.MerchTier, Data.Product, Data.Programme, Data.TC, Data.BID, Data.BIN, Data.Count, Data.Amount, Data.CashBack, Data" _
' , _
' ".NetCount, Data.NetAmount, Data.IRF_Product, Data.IRF_Programme2, Data.IRF_FEE, Data.FeeText, Data.NetFeeText, Data.FeeNum, Data.NetFee" & Chr(13) & "" & Chr(10) & "FROM `C:\Temp\VP_Work\ERA\ExportData`.Data Data" _
' )
' .CreatePivotTable TableDestination:="[RecordCode.xls]Sheet1!R6C2", _
' Tablename:="PivotTable1", DefaultVersion:=xlPivotTableVersion10
.Connection = "ODBC;DSN=MS Access Database;DBQ=" & sourceDir & "\" & sourceFile & ";DefaultDir=" & sourceDir & ";DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;"
.CommandType = xlCmdSql
' cmdText = "SELECT Data.YearMonth, Data.IssCountry, Data.FeeDesc, Data.FeeTier, Data.Member, Data.MerchTier, Data.Product, Data.Programme, Data.TC, Data.BID, Data.BIN, Data.Count, Data.Amount, Data.CashBack, Data.NetCount, Data.NetAmount, Data.IRF_Product, Data.IRF_Programme2, Data.IRF_FEE, Data.FeeText, Data.NetFeeText, Data.FeeNum, Data.NetFee FROM Data"
cmdText = "SELECT * FROM Data"
End Select
.CommandText = cmdText
.CreatePivotTable TableDestination:=ws.Name & "!r10c2", Tablename:="Pivot_1", DefaultVersion:=xlPivotTableVersion10
End With
fnAddFieldsToPivot "Pivot_1", ws
wb.Save
'wb.Close
' xl.Visible = True
fnBuildPivot = sourceDir & "\" & FileNameLessXtn & "_pivot.xls"
PROC_EXIT:
On Error Resume Next
Set ws = Nothing
wb.Close
Set wb = Nothing
xl.Quit
Set xl = Nothing
Exit Function
PROC_ERR:
Debug.Print Err.Description
MsgBox Err.Description
Resume PROC_EXIT
Resume
End Function
Private Function fnAddFieldsToPivot(PivotTableName As String, ws As Worksheet)
On Error GoTo PROC_ERR
If Not fnIsLoaded("frmGrouping") Then Exit Function
With ws.PivotTables(PivotTableName)
If Forms!frmGrouping!chkNetCount Then
' .AddDataField ActiveSheet.PivotTables(PivotTableName).PivotFields("SumOfNetCount"), "Sum of SumOfNetCount", xlSum
.AddDataField ws.PivotTables(PivotTableName).PivotFields("SumOfNetCount"), "Sum of SumOfNetCount", xlSum
End If
If Forms!frmGrouping!chkNetAmount Then
' .AddDataField ActiveSheet.PivotTables(PivotTableName).PivotFields("SumOfNetAmount"), "Sum of SumOfNetAmount", xlSum
.AddDataField ws.PivotTables(PivotTableName).PivotFields("SumOfNetAmount"), "Sum of SumOfNetAmount", xlSum
End If
If Forms!frmGrouping!chkNetAmount Then
' .AddDataField ActiveSheet.PivotTables(PivotTableName).PivotFields("SumOfNetFee"), "Sum of SumOfNetFee", xlSum
.AddDataField ws.PivotTables(PivotTableName).PivotFields("SumOfNetFee"), "Sum of SumOfNetFee", xlSum
End If
With .DataPivotField
.Orientation = xlColumnField
.Position = 1
End With
If Forms!frmGrouping!chkCountry Then
With .PivotFields("Country")
.Orientation = xlRowField
.Position = 1
End With
End If
If Forms!frmGrouping!chkYearMonth Then
With .PivotFields("YearMonth")
.Orientation = xlRowField
.Position = 2
End With
End If
End With 'ws.PivotTables(PivotTableName)
PROC_EXIT:
On Error Resume Next
Exit Function
PROC_ERR:
Debug.Print Err.Description
MsgBox Err.Description
Resume PROC_EXIT
End Function