Binaryworld - CloneFieldStructure - Create a new Recordset with same field structure ... [ VB -> ADO ]

' 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