CloneFieldStructure - Create a new Recordset with same field structure

' Copy the field structure of a Recordset to a new Recordset.
'
' The original code has been improved to account for Numeric and Decimal
' fields, that also require the setting of Precision and Numeric Scale 
' properties.
' Thanks to Robert Gelb for this suggestion.

Function CloneFieldStructure(rs As ADODB.Recordset) As ADODB.Recordset
    Dim fld As ADODB.Field

    Set CloneFieldStructure = New ADODB.Recordset

    ' create a set of fields with same attributes
    For Each fld In rs.Fields
        CloneFieldStructure.Fields.Append fld.name, fld.Type, fld.DefinedSize, _
            fld.Attributes

        'special handling for data types with numeric scale & precision
        Select Case fld.Type
            Case adNumeric, adDecimal
                With CloneFieldStructure
                    .Fields(.Fields.Count - 1).Precision = fld.Precision
                    .Fields(.Fields.Count - 1).NumericScale = fld.NumericScale
                End With
        End Select
    

    Next


End Function