Populate XL cells with values from a user defined type

[John]

All,

I am trying to populate a spreadsheet with records from a user defined type.
Something like:
Define Type ReportRecords
ActID as String * 10
Act_Title as String *40
Budget as Currency
End Type

Dim rFld as ReportRecords

Then I do some stuff to populate the values (not all of them) in the
ReportRecords user defined type.

Next I open an Excel application and get it all set up to accept valuses.
My user defined type has 92 fields. Here's a sample of the code:

'Write the record to excel, incriment the row counter, get the data for next
activity...

xlSht.Cells(rCnt, 1).Value = rFld.Job
xlSht.Cells(rCnt, 2).Value = rFld.Phase
xlSht.Cells(rCnt, 3).Value = rFld.ActID
xlSht.Cells(rCnt, 4).Value = rFld.Act_Title
xlSht.Cells(rCnt, 5).Value = rFld.BLbr

My question is, is there a way to use a counter to loop through the
user-defined type fields instead of having to list all 91 of them? Something
like:

dim fldNo as Intiger 'user-defined type field counter
dim cCnt as intiger 'Column counter
cCnt=1
fldNo=0
For cCnt=1 to 91
xlSht.Cells(rCnt, i).Value = rFld.field(fldNo)
fldNo = fldNo + 1
next i

If I want the fields in a specific order, is there a way to control that?
When I type the type name "rFld." when I hit the ".", it lists my fields, but
they are in alpha order. Is this also the index order? Not all of my
user-defined fields are used, is there a way to skip the ones I don't want in
the spreadsheet?

Sorry for the long post with lots of questions!

 

[PieterLinden via AccessMonster.com]

All,

I am trying to populate a spreadsheet with records from a user defined type.
Something like:
Define Type ReportRecords
ActID as String * 10
Act_Title as String *40
Budget as Currency
End Type

What if you created a fabricated recordset in ADO and just passed that? You
can use CopyFromRecordset in Excel and just stuff them into a contiguous
range.

 

[John]

PieterLinden,

That sounds intreaging, but you will have to excuse my ignorance... How do
you create a "...fabricated recordset in ADO"? I assume this would replace
my user-defined type (?).

 

[PieterLinden via AccessMonster.com]

John,
if you use a recordset, you don't need the UDT. The handy thing about a
recordset is that you can sort and filter it (if you wish) - and all the
methods are built in.

Here's an example of using CopyFromRecordset that I rather shamelessly stole
from MSFT...

Option Compare Database
Option Explicit

Private Sub Command1_Click()
Dim cnt As New ADODB.Connection
Dim rst As New ADODB.Recordset

Dim xlApp As Object
Dim xlWb As Object
Dim xlWs As Object


Dim recArray As Variant

Dim strDB As String
Dim fldCount As Integer
Dim recCount As Long
Dim iCol As Integer
Dim iRow As Integer

'THIS IS MY TWEAK ... it calls a function that returns the recordset I
made... (see below for that code)

Set rst = BudgetRS()

' Create an instance of Excel and add a workbook
Set xlApp = CreateObject("Excel.Application")
Set xlWb = xlApp.Workbooks.Add
Set xlWs = xlWb.Worksheets("Sheet1")

' Display Excel and give user control of Excel's lifetime
xlApp.Visible = True
xlApp.UserControl = True

' Copy field names to the first row of the worksheet
fldCount = rst.Fields.Count
For iCol = 1 To fldCount
xlWs.Cells(1, iCol).Value = rst.Fields(iCol - 1).Name
Next

' Check version of Excel
If Val(Mid(xlApp.Version, 1, InStr(1, xlApp.Version, ".") - 1)) > 8 Then
'EXCEL 2000,2002,2003, or 2007: Use CopyFromRecordset

' Copy the recordset to the worksheet, starting in cell A2
xlWs.Cells(2, 1).CopyFromRecordset rst
'Note: CopyFromRecordset will fail if the recordset
'contains an OLE object field or array data such
'as hierarchical recordsets

Else
'EXCEL 97 or earlier: Use GetRows then copy array to Excel

' Copy recordset to an array
recArray = rst.GetRows
'Note: GetRows returns a 0-based array where the first
'dimension contains fields and the second dimension
'contains records. We will transpose this array so that
'the first dimension contains records, allowing the
'data to appears properly when copied to Excel

' Determine number of records

recCount = UBound(recArray, 2) + 1 '+ 1 since 0-based array


' Check the array for contents that are not valid when
' copying the array to an Excel worksheet
For iCol = 0 To fldCount - 1
For iRow = 0 To recCount - 1
' Take care of Date fields
If IsDate(recArray(iCol, iRow)) Then
recArray(iCol, iRow) = Format(recArray(iCol, iRow))
' Take care of OLE object fields or array fields
ElseIf IsArray(recArray(iCol, iRow)) Then
recArray(iCol, iRow) = "Array Field"
End If
Next iRow 'next record
Next iCol 'next field

' Transpose and Copy the array to the worksheet,
' starting in cell A2
xlWs.Cells(2, 1).Resize(recCount, fldCount).Value = _
TransposeDim(recArray)
End If

' Auto-fit the column widths and row heights
xlApp.Selection.CurrentRegion.Columns.AutoFit
xlApp.Selection.CurrentRegion.Rows.AutoFit

' Close ADO objects
rst.Close
Set rst = Nothing


' Release Excel references
Set xlWs = Nothing
Set xlWb = Nothing

Set xlApp = Nothing

End Sub

Function TransposeDim(v As Variant) As Variant
' Custom Function to Transpose a 0-based array (v)

Dim X As Long, Y As Long, Xupper As Long, Yupper As Long
Dim tempArray As Variant

Xupper = UBound(v, 2)
Yupper = UBound(v, 1)

ReDim tempArray(Xupper, Yupper)
For X = 0 To Xupper
For Y = 0 To Yupper
tempArray(X, Y) = v(Y, X)
Next Y
Next X

TransposeDim = tempArray


End Function


Public Function BudgetRS() As ADODB.Recordset
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset

With rs
.CursorLocation = adUseClient 'NEED this for disconnected recordset
.CursorType = adOpenStatic

'-- define the fields in the recordset
.Fields.Append "AcctID", adVarChar, 10, adFldFixed
.Fields.Append "AccountTitle", adVarChar, 40, adFldFixed
.Fields.Append "Budget", adCurrency

'-- open the recordset so we can use it
.Open

'-- add several records.
.AddNew
.Fields("AcctID") = "0123456789"
.Fields("AccountTitle") = "Drinking Budget"
.Fields("Budget") = 900000
.Update

.AddNew
.Fields("AcctID") = "000000001"
.Fields("AccountTitle") = "Mortgage Budget"
.Fields("Budget") = 12000
.Update

.AddNew
.Fields("AcctID") = "1000000001"
.Fields("AccountTitle") = "Spouse Slush Fund"
.Fields("Budget") = 5000000
.Update

End With

Set BudgetRS = rs ' set the return value of the function to the
fabricated recordset
Set rs = Nothing

End Function


Hope this points you in the right direction...
Pieter