Append Fields in an Existing ADO Recordset

[Junoon]

hi,

I am using an ADO recordset in Excel to grab a huge CSV (~1 million rows) and use it as External data to create a PivotCache & Pivottable.

I want to edit the recordset to append additional fields (columns) and add data that is calculated from one of the fields viz a week field which has string data like this:

e.g. if A, B, C are the recordset fields,

A B C D E
w 2011 01 01 2011
w 2011 02 02 2011
w 2011 03 03 2011
w 2011 04 04 2011
w 2012 05 05 2012


then I want to append fields D, E and add data to them as shown above, stripped from column A like I would do in excel,

D = VALUE(RIGHT(A2,2))
E = VALUE(MID(A2,3,4))

but I want to do using SQL functions.

then I use this appended recordset to create a pivotcache and a pivottable using it as an external datasource.
SEE MY COMMENTS IN THE CODE.

Option Explicit

Sub GetCSV()
Application.EnableEvents = False
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim sFileName As String
Dim sFilePath As String
Dim rngPivotDest As Range
Dim pcPivotCache As PivotCache
Dim ptPivotTable As PivotTable
Dim SQL As String
Dim sConnStrP1 As String
Dim sConnStrP2 As String
Dim cConnection As Object
Dim rsRecordset As Object, RS As Object, Fld As Object
Dim Sht As Worksheet
Dim Conn As Object

With ThisWorkbook

Set rsRecordset = CreateObject("ADODB.Recordset")
Set RS = CreateObject("ADODB.Recordset")
Set cConnection = CreateObject("ADODB.Connection")


sFileName = Application.GetOpenFilename("Text Files, *.asc; *.txt; *.csv", 1, "Select a Text File", , False)
sFilePath = Left(sFileName, InStrRev(sFileName, "\"))
sFileName = Replace(sFileName, sFilePath, "")
    
    
sConnStrP1 = "Driver={Microsoft Text Driver (*.txt; *.csv)};Dbq="
sConnStrP2 = ";Extensions=asc,csv,tab,txt;FIL=text;Persist Security Info=False"

cConnection.Open sConnStrP1 & sFilePath & sConnStrP2
SQL = "SELECT * FROM [" & sFileName & "]"
Set rsRecordset = cConnection.Execute(SQL)


'****** THIS ENTIRE PART IS NOT WORKING******
With RS
    .cursorlocation = 3 'aduseclient
    .cursortype = 2 'adOpenDynamic 3 'adopenstatic
'    For Each Fld In rsRecordset.Fields
'        .Fields.append Fld.Name, Fld.Type, Fld.definedsize, Fld.Attributes, Fld.adFldIsNullable
'    Next Fld
    .locktype = 4 'adLockBatchOptimistic'3 'adlockoptimistic
    .Fields.append "WeekNumber", 3 'adinteger
    .Fields.append "Year", 7 'addate
    
    .Open
    .Update
        
'do something to grab the entire data into RS
Set RS = rsRecordset.Clone
'or something like
Set RS = rsRecordset.getrows

'append some function code to the last 2 fields to strip YEAR & WEEK from 1st field.
......
......

    
End With
*********************************

'Delete any connections in workbook
On Error Resume Next
For Each Conn In .Connections
    Conn.Delete
Next Conn
On Error GoTo 0

'Delete the Pivot Sheet
On Error Resume Next
For Each Sht In .Sheets
    If LCase(Trim(Sht.Name)) = LCase("Pivot") Then Sht.Delete
Next Sht
On Error GoTo 0

'Create a PivotCache
Set pcPivotCache = .PivotCaches.Create(SourceType:=xlExternal)
Set pcPivotCache.Recordset = rsRecordset

'Create a Pivot Sheet
.Sheets.Add after:=.Sheets("Main")
ActiveSheet.Name = "Pivot"

'Create a PivotTable
Set ptPivotTable = pcPivotCache.CreatePivotTable(TableDestination:=.Sheets("Pivot").Range("A3"))

With ptPivotTable
    .Name = "PivotTable"
    .SaveData = False
End With


With ptPivotTable
    With .PivotFields("Level")
    .Orientation = xlPageField
    .Position = 1
    End With
    With .PivotFields("Cat")
    .Orientation = xlPageField
    .Position = 1
    End With
    With .PivotFields("Mfgr")
    .Orientation = xlPageField
    .Position = 1
    End With
    With .PivotFields("Brand")
    .Orientation = xlPageField
    .Position = 1
    End With
    With .PivotFields("Descr")
    .Orientation = xlRowField
    .Position = 1
    End With
End With

ptPivotTable.AddDataField ptPivotTable.PivotFields("Sales Value from CrossCountrySales"), "Sum of Sales Value from CrossCountrySales", xlSum

With ptPivotTable.PivotFields("Week")
    .Orientation = xlColumnField
    .Position = 1
End With

With ptPivotTable.PivotFields("Sum of Sales Value from CrossCountrySales")
    .Calculation = xlNoAdditionalCalculation
End With

cConnection.Close
Set rsRecordset = Nothing
Set cConnection = Nothing
Set Conn = Nothing

End With

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True

End Sub