Import Recordset

[MFRASER]

Is there a way inside of Excel to import a ADO.Recordset inside of Code?

 

[Frank Kabel]

Hi
have a look at
http://www.dicks-clicks.com/excel/ExternalData3.htm#CreateVBA

 

[Guest]

What do you mean by Import? What are you trying to do

Sorry for the confusion

-Brad

 

[MFRASER]

I am trying to ultimately create a pivot table that is bound to a
spreadsheet. Previously I had the pivot table bound to a recordset but I
wanted to append data. The way I thought I could get around this would be
to populate a datasheet with data and then append data when I needed to and
have the pivot table bound to the datasheet.

Here is my sample code to import the recordset

Private Sub BuildDataSheet(rs As ADODB.Recordset, sheet As Worksheet)
Dim TargetRange As Range
Dim intColIndex As Integer
Set TargetRange = sheet.Range("A1")
' optional approach for Excel 2000 or later (RS2WS is not necessary)
For intColIndex = 0 To rs.Fields.Count - 1 ' the field names
TargetRange.Offset(0, intColIndex).Value =
rs.Fields(intColIndex).Name
Next
TargetRange.Offset(1, 0).CopyFromRecordset rs ' the recordset data

End Sub


and here is my code to bind the pivot table. Problem is that the last line
does not work properly , any ideas?

Private Function AddPivotTable(rst As ADODB.Recordset, sheet As Worksheet,
Datasheet As Worksheet) As PivotTable

'Dim pCache As Excel.PivotCache
Dim pTable As PivotTable

'Set pCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlExternal)
'Set pCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase)
'Set pCache.Recordset = rst
'pCache.SourceData = Datasheet.Range("A1:FB4000")
'Set pTable = pCache.CreatePivotTable(sheet.Range("A8"))
'Set AddPivotTable = pTable
Set pTable = sheet.PivotTableWizard(xlConsolidation,
Datasheet.Range("A1", "F4000"), "A8")

End Function

 

[onedaywhen]

You can use the recordset's Save method to persist it on disk, then
later use its Open method. You can certainly do this 'inside of code'.
For further details see:

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/ado270/htm/mdmthrstsave.asp

 

[MFRASER]

Ok. I am almost there but I can't seem to get the code to work with a named
range here is my code.

Private Function AddPivotTable(rst As ADODB.Recordset, sheet As Worksheet,
DataSheet As Worksheet) As PivotTable

Dim pTable As PivotTable

Dim TargetRange As Range

Dim RangeName As String

Dim aName As Name



'Test if pivot table already exists

Set TargetRange = DataSheet.Cells.SpecialCells(xlCellTypeLastCell)

'RangeName = "" & DataSheet.Name & " !R1C1:R" & TargetRange.Row & "C" &
TargetRange.Column

RangeName = "'Income Statement_DATA'!Database"

Set aName = sheet.Names("Database")

If sheet.PivotTables.Count = 0 Then

'FAILS RIGHT HERE?

Set pTable = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase,
SourceData:="" + RangeName +
"").CreatePivotTable(TableDestination:=sheet.Range("A8"), TableName:="PT" &
sheet.Name & "")

Else

Set pTable = sheet.PivotTables(1)

End If

Set AddPivotTable = pTable

End Function

Private Sub BuildDataSheet(rs As ADODB.Recordset, sheet As Worksheet)

Dim TargetRange As Range

Dim intColIndex As Integer

Dim intRowIndex As Integer

Dim aName As Name


Set TargetRange = sheet.Cells.SpecialCells(xlCellTypeLastCell)

'if datasheet is blank then insert field names

If TargetRange.Column = 1 And TargetRange.Row = 1 Then

' optional approach for Excel 2000 or later (RS2WS is not necessary)

For intColIndex = 0 To rs.Fields.Count - 1 ' the field names

TargetRange.Offset(0, intColIndex).Value = rs.Fields(intColIndex).Name

Next

TargetRange.Offset(1, 0).CopyFromRecordset rs ' the recordset data


Set TargetRange = sheet.Cells.SpecialCells(xlCellTypeLastCell)

sheet.Names.Add Name:="Database", RefersToR1C1:= _

"=" & sheet.Name & "!R1C1:R" & TargetRange.Row & "C" & TargetRange.Column


Else

intRowIndex = TargetRange.Row + 1

TargetRange.Offset(intRowIndex, 0).CopyFromRecordset rs ' the recordset data

Set aName = sheet.Names("Database")

aName.RefersToR1C1 = "=" & sheet.Name & "!R1C1:R" & TargetRange.Row & "C" &
TargetRange.Column

End If