I have written the following code using the MS KnowledgeBase Article
Creating a Data Aware Class and would like to write the fields in my
recordset out to an existing table called GlassPro which has columns with
the same names assigned to the fields in the recordset. To this end I have
written a function called WriteToFile() of this Data Aware Class called
GlassDataSource. The WriteToFile() function has the Connection String set up
correctly but that is all. Can anyone help me ?

Public rsGlass As ADODB.Recordset

Public Sub Class_GetDataMember(DataMember As String, Data As Object)
Set Data = rsGlass
End Sub

Public Sub Class_Initialize()

Dim fld As ADODB.Field
Dim strRow As String
Dim strField As String

Set rsGlass = New ADODB.Recordset

With rsGlass
.Fields.Append "CustomerCode", adVarChar, 6, adFldUpdatable
.Fields.Append "CustomerName", adVarChar, 30, adFldUpdatable
.Fields.Append "OrderDate", adVarChar, 6, adFldUpdatable
.Fields.Append "Batch Number", adVarChar, 8, adFldUpdatable
.Fields.Append "Order Number", adVarChar, 6, adFldUpdatable
.Fields.Append "ItemNumber", adVarChar, 3, adFldUpdatable
.Fields.Append "Quantity", adVarChar, 4, adFldUpdatable
.Fields.Append "GlassLeaf1", adVarChar, 6, adFldUpdatable
.Fields.Append "GlassLeaf2", adVarChar, 6, adFldUpdatable
.Fields.Append "SpacerCode", adVarChar, 3, adFldUpdatable
.Fields.Append "Width1", adVarChar, 4, adFldUpdatable
.Fields.Append "Width2", adVarChar, 4, adFldUpdatable
.Fields.Append "Height1", adVarChar, 4, adFldUpdatable
.Fields.Append "Height2", adVarChar, 4, adFldUpdateable
.Fields.Append "ProductionDesc", adVarChar, 32, adFldUpdateable
.Fields.Append "DeliveryDate", adVarChar, 6, adFldUpdateable
.Fields.Append "DeliveryName", adVarChar, 30, adFldUpdateable
.Fields.Append "OrderReference", adVarChar, 20, adFldUpdateable
.Fields.Append "Comment", adVarChar, 20, adFldUpdatable
.Fields.Append "GlassLeaf3", adVarChar, 6, adFldUpdatable
.Fields.Append "SpacerCode2", adVarChar, 3, adFldUpdatable
.Fields.Append "ProcessWork1", adVarChar, 20, adFldUpdatable
.Fields.Append "ProcessWork2", adVarChar, 20, adFldUpdatable
.Fields.Append "ProcessWork3", adVarChar, 20, adFldUpdatable
.Fields.Append "ProcessWork4", adVarChar, 20, adFldUpdatable
.Fields.Append "ProcessWork5", adVarChar, 20, adFldUpdatable
.Fields.Append "ProductionDescription", adVarChar, 20, adFldUpdatable
.Fields.Append "DeliveryRoute", adVarChar, 2, adFldUpdatable
.Fields.Append "CollectedCode", adVarChar, 1, adFldUpdatable
.Fields.Append "PackedCode", adVarChar, 1, adFldUpdatable
.Fields.Append "ProductRoute1", adVarChar, 4, adFldUpdatable
.Fields.Append "ProductRoute2", adVarChar, 4, adFldUpdatable
.Fields.Append "ProductRoute3", adVarChar, 4, adFldUpdatable
.Fields.Append "ProductRoute4", adVarChar, 4, adFldUpdatable
.Fields.Append "ProductRoute5", adVarChar, 4, adFldUpdatable
.Fields.Append "ProductRoute6", adVarChar, 4, adFldUpdatable
.Fields.Append "ProductRoute7", adVarChar, 4, adFldUpdatable
.Fields.Append "ProductRoute8", adVarChar, 4, adFldUpdatable
.Fields.Append "ProductRoute9", adVarChar, 4, adFldUpdatable
.Fields.Append "ProductRoute10", adVarChar, 4, adFldUpdatable
.Fields.Append "ShapeCode", adVarChar, 1, adFldUpdatable
.Fields.Append "ShapeDims1", adVarChar, 4, adFldUpdatable
.Fields.Append "ShapeDims2", adVarChar, 4, adFldUpdatable
.Fields.Append "ShapeDims3", adVarChar, 4, adFldUpdatable
.Fields.Append "ShapeDims4", adVarChar, 4, adFldUpdatable
.Fields.Append "ShapeDims5", adVarChar, 4, adFldUpdatable
.Fields.Append "ShapeDims6", adVarChar, 4, adFldUpdatable
.Fields.Append "ShapeDims7", adVarChar, 4, adFldUpdatable
.Fields.Append "ShapeDims8", adVarChar, 4, adFldUpdatable
.Fields.Append "ShapeDims9", adVarChar, 4, adFldUpdatable
.Fields.Append "ShapeDims10", adVarChar, 4, adFldUpdatable
' use keyset cursor type to allow updating records.
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
.Open
End With

Open "C:\Data\Gpopt2.DAT" For Input As #1

Do Until EOF(1)
    Line Input #1, strRow
    With rsGlass
        .AddNew
        For Each fld In .Fields
            fld.Value = Left(strRow, fld.DefinedSize)
            strRow = Mid(strRow, fld.DefinedSize + 1)
        Next
        .Update
    End With
Loop
Close
rsGlass.MoveFirst
End Sub

Public Function WriteToFile()
Dim conn As New ADODB.Connection
Dim cmd As New ADODB.Command
Dim tablename As TableDef
Dim fld As ADODB.Field
Dim strField As String

conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data
Source=C:\Data\highway.mdb;Persist Security Info=False"

Set cmd.ActiveConnection = conn
rsGlass.CursorLocation = adUseServer
cmd.CommandText = "INSERT INTO GlassPro(CustomerCode)"
conn.BeginTrans
rsGlass.Open cmd, adOpenDynamic, adLockOptimistic

conn.CommitTrans
Else
conn.RollbackTrans
End If

rsGlass.Close
conn.Close
Set rsGlass = Nothing
Set conn = Nothing
End Function