I need help creating a pivot table in VBScript

[PHRoche]

I hope someone can help me. I have a VBScript program to read a flat delimited file into Excel and then try to create a pivot table.

My data looks a bit like this:
Segment Amount 1 Amount 2
Corp 100.00 100.00
Elect 200.00 200.00
Corp 100.00 0.00
Elect 100.00 50.00

I want to see
Segment Sum of Amount 1 Sum of Amount 2
Corp 200.00 100.00
Elect 300.00 250.00

I get

Segment
Corp Sum of Amount 1 200.00
Sum of Amount 2 100.00

Elect Sum of Amount 1 300.00
Sum of Amount 2 250.00

I've tried recording a macro in Excel and using the code, but it doesn't work, Help!

Here is my code I know it's not complete, but I wanted to get through the pivot table section first to see what it looks like.

'Option explicit
Const ForReading = 1
Dim FSOFOLDER, Folder, FileList, File, objFSOFILEREAD, objFileRead, objFSOFILE, objFile
Dim objTestFILE, objTfile, fExtension, fName
Dim strContents, TranArray, infolder, outfolder, today, modDate, modMonth, modYear
Dim FieldCount, NstrContents, I
Dim objExcel
Dim objWorkbook
Dim objWorkSheet
Dim RecCount, objRange
Dim Count
Dim Destination
Const xlRowField=1
Const xlColumnField=2
Const xlSum = -4157

infolder = "My Folder IN"
outfolder = "My Folder OUT"


today = Date()
modDate = DateAdd("m",-1,today)
modMonth = MonthName(DatePart("m", modDate),True)
modYear = Mid(modDate,(InStrRev(modDate,"/")+1),4)

'Create new Excel File

Set FSOFOLDER = CreateObject("Scripting.FileSystemObject"
Set objFSOFILEREAD = CreateObject("Scripting.FileSystemObject"
Set Folder = FSOFOLDER.GetFolder(infolder)
Set FileList = Folder.Files
Set objExcel = CreateObject("Excel.Application")
objExcel.Workbooks.Add
'objExcel.Visible = False
objExcel.Visible = True
objExcel.Sheets.Add.name = "Scorecard Detail"
'Set objWorkbook = objExcel.Workbooks.Add
'Set objWorksheet= ojbExcel.Sheets.Add.name = "Scorecard Detail"

For Each File In FileList
fExtension = FSOFOLDER.GetExtensionName(File.Name)
fExtension = LCase(fExtension)

If fExtension = "csv" Then
'Set objFSOFILE = CreateObject("Scripting.FileSystemObject"
'Set objFSOFILEREAD = CreateObject("Scripting.FileSystemObject"
Set objFileRead = objFSOFILEREAD.OpenTextFile(File.path, ForReading)

FilRecCount = 1
RecCount = 1
'DefHeadings
SetColFMT
'LastPlant = "Division_Number"

Do While RecCount < 100 'Restrict to 100 records.
'Do While Not objfileread.AtEndOfStream
strContents = objFileRead.ReadLine
strContents = Replace(strContents,""""," ;")
TranArray = Split(strContents,",",-1)
FieldCount = UBound(TranArray)
Set Destination = objExcel.ActiveSheet.Range("A" & RecCount & ": AF" & RecCount).Resize
Destination.Value = TranArray
RecCount = RecCount + 1
Loop
End if
Next
RecCount= RecCount - 1
'objFileRead.Close

Everything above works fine, Here is where I'm having an issue.

objExcel.Sheets.Add.name = "Summary"
objExcel.sheets("Scorecard Detail").select
objExcel.Columns("A:AF").select
objExcel.ActiveSheet.PivotTableWizard SourceType=xlDatabase,objExcel.Range("A1:AF"; & RecCount),"Summary!R1C1","Scorecard Detail"
objExcel.ActiveSheet.PivotTables("Scorecard Detail").PivotFields("Sector").Orie ntation = 1
objExcel.ActiveSheet.PivotTables("Scorecard Detail").PivotFields("Functional Open Amount in USD").Orientation = xlColumnField
objExcel.ActiveSheet.PivotTables("Scorecard Detail").AddDataField objExcel.ActiveSheet.PivotTables("Scorecard Detail").PivotFields("Functional Open Amount in USD"), "Sum of Open Amount in USD", xlSum
objExcel.ActiveSheet.PivotTables("Scorecard Detail").PivotFields("Functional Open Amount in USD").NumberFormat = "$#,##0.00"
objExcel.ActiveSheet.PivotTables("Scorecard Detail").PivotFields("Functional AGE < 12 MO in USD").Orientation = xlColumnField
objExcel.ActiveSheet.PivotTables("Scorecard Detail").AddDataField objExcel.ActiveSheet.PivotTables("Scorecard Detail").PivotFields("Functional AGE < 12 MO in USD"), "Sum of Functional AGE < 12 MO in USD", xlSum
objExcel.ActiveSheet.PivotTables("Scorecard Detail").PivotFields("Functional Open Amount in USD").NumberFormat = "$#,##0.00"
With objExcel.ActiveSheet.PivotTables("Scorecard Detail").DataPivotField.NumberFormat = "$#,##0.00" '.Orientation = xlColumnField
End With

'********************************************************
' Formats various Cells
Sub SetColFMT
objExcel.Columns("A:N").Select 'set A to M as text
objExcel.Selection.NumberFormat = "@"
objExcel.Columns("A:N").ColumnWidth = 9.00
objExcel.Columns("G:G").ColumnWidth = 45.00
objExcel.Columns("K:K").ColumnWidth = 15.00
objExcel.Columns("L:L").ColumnWidth = 19.00
objExcel.Columns("M:M").ColumnWidth = 21.00
objExcel.Columns("O:AF").Select 'Set N to AF as formatted amount
objExcel.Selection.NumberFormat = "$#,##0.00"
objExcel.Columns("O:AF").ColumnWidth = 29.00



End Sub

[hagchr]

Hi, I have not had a chance to go through the script in detail but just a quick example producing the pivot layout you looked for. (Opening an excel sheet, assuming the source data is in Sheet1, starting in cell A1):

Segment Amount 1 Amount 2
Corp 100.00 100.00
Elect 200.00 200.00
Corp 100.00 0.00
Elect 100.00 50.00
...

Code: Select all

VBSTART
    Sub Test
      xlRowField=1
      xlColField=4
      
      File="C:\...\Yourfile.xls"
      Set objExcel = CreateObject("Excel.Application")
      objExcel.Visible = True
      Set objWorkbook = objExcel.Workbooks.Open(File)
      objWorkBook.Sheets("Sheet1").Activate
      objWorkBook.Sheets("Sheet1").Range("A1").Select
      Set objTable = objWorkbook.PivotTableWizard
      Set objField = objTable.PivotFields("Segment")
      objField.Orientation = xlRowField
            
      Set objField = objTable.PivotFields("Amount 1")
      objField.Orientation = xlColField
            
      Set objField = objTable.PivotFields("Amount 2")
      objField.Orientation = xlColField
      objTable.DataPivotField.Orientation=2
    End Sub
VBEND
VBRun>Test