Results 1 to 4 of 4

Thread: Append Fields in an Existing ADO Recordset

  1. #1
    Junior Member
    Join Date
    May 2012
    Posts
    25
    Rep Power
    0

    Append Fields in an Existing ADO Recordset

    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.

    PHP 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 ObjectRS As ObjectFld 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(sFileNameInStrRev(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 
    Last edited by Junoon; 05-22-2014 at 11:10 PM. Reason: http://www.utteraccess.com/forum/Append-Fields-Existin-t2018243.html

  2. #2
    Senior Member LalitPandey87's Avatar
    Join Date
    Sep 2011
    Posts
    222
    Rep Power
    14
    You can not append a new blank field in the same recordset but there is a workaround for this:

    1. First get all data in one recordset which is Recordset1
    2. Then create a new recordset Recordset2 and add all existing field form Recordset1
    3. Add new field in Recordset2
    4. Add data from Recordset1 to Recordset2


    Code:
    strSql = "Select Column1, Column2 from Table1"
    With rs
        .Open strSql, Con, adOpenForwardOnly, adLockBatchOptimistic
    End With
    
    
    rscp.Fields.Append "Column1", adVarChar, 6
    rscp.Fields.Append "Column2", adVarChar, 6
    rscp.Fields.Append "Column3", adVarChar, 50 'New Column
    rscp.Open
    
    
    For i = 1 To rs.RecordCount
        rscp.AddNew _
        Array("Column1", "Column2", "Column3"), _
        Array(rs.Fields(0).Value, rs.Fields(1).Value, Null)
        rs.MoveNext
    Next

    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=314837#p314837
    https://www.eileenslounge.com/viewtopic.php?f=21&t=40701&p=314836#p314836
    https://www.eileenslounge.com/viewtopic.php?f=27&t=40621&p=314621#p314621
    https://www.eileenslounge.com/viewtopic.php?f=27&t=40621&p=314619#p314619
    https://www.eileenslounge.com/viewtopic.php?f=27&t=40621&p=314600#p314600
    https://www.eileenslounge.com/viewtopic.php?f=27&t=40621&p=314599#p314599
    https://www.eileenslounge.com/viewtopic.php?f=27&t=40621&p=314274#p314274
    https://www.eileenslounge.com/viewtopic.php?f=27&t=40621&p=314229#p314229
    https://www.eileenslounge.com/viewtopic.php?f=27&t=40621&p=314195#p314195
    https://www.eileenslounge.com/viewtopic.php?f=36&t=39706&p=314110#p314110
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40597&p=314081#p314081
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40597&p=314078#p314078
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=314062#p314062
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40597&p=314054#p314054
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=313971#p313971
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=313909#p313909
    https://www.eileenslounge.com/viewtopic.php?f=27&t=40574&p=313879#p313879
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=313859#p313859
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=313855#p313855
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=313848#p313848
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=313843#p313843
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=313792#p313792
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40560&p=313771#p313771
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40560&p=313767#p313767
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40560&p=313746#p313746
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40560&p=313744#p313744
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40560&p=313741#p313741
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=313622#p313622
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=313575#p313575
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=313573#p313573
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=313563#p313563
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=313555#p313555
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40533
    https://www.eileenslounge.com/viewtopic.php?f=39&t=40265&p=313468#p313468
    https://www.eileenslounge.com/viewtopic.php?f=42&t=40505&p=313411#p313411
    https://www.eileenslounge.com/viewtopic.php?f=32&t=40473&p=313384#p313384
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40501&p=313382#p313382
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40501&p=313380#p313380
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40501&p=313378#p313378
    https://www.eileenslounge.com/viewtopic.php?f=32&t=40473&p=313305#p313305
    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
    Last edited by DocAElstein; 03-04-2024 at 05:48 PM.

  3. #3
    Member Transformer's Avatar
    Join Date
    Mar 2012
    Posts
    91
    Rep Power
    13
    Last edited by DocAElstein; 04-11-2024 at 06:20 PM.
    Regards,

    Transformer

  4. #4

Similar Threads

  1. Export data from Excel to Access Table (ADO) using VBA
    By Admin in forum Excel and VBA Tips and Tricks
    Replies: 4
    Last Post: 02-24-2015, 07:53 PM
  2. Replies: 7
    Last Post: 04-04-2014, 03:16 PM
  3. VBA Trick of the Week: Range to Recordset Without Making Connection
    By Transformer in forum Tips, Tricks & Downloads (No Questions)
    Replies: 0
    Last Post: 07-11-2013, 06:21 PM
  4. Split Closed Workbook into Multiple Workbooks Using ADO
    By ramakrishnan in forum Excel Help
    Replies: 4
    Last Post: 10-02-2011, 08:34 PM
  5. Replies: 9
    Last Post: 09-09-2011, 02:30 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •