Writing Fields to an ACCESS 2000 Table 
Author Message
 Writing Fields to an ACCESS 2000 Table

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



Tue, 15 Jul 2003 21:49:54 GMT  
 
 [ 1 post ] 

 Relevant Pages 

1. Writing Fields to an ACCESS 2000 Table

2. Writing Fields to an ACCESS 2000 Table

3. VBA - Access 2000 Create a table and access the fields

4. error writing date field to Access 2000 using SQL statement in VB 6

5. Automatically append a field to a table in Access (2000 or XP)

6. Add fields to an Access 2000 Table on the fly using ADO 2.1

7. Importing an Access 2000 table into another Access 2000 database with VB Code

8. Read/Write to OLE field in Access Table?

9. Linking Access 2000 Table to Outlook 2000 Tasks

10. Application written for Access 2000 with DAO won't run in Access 2002

11. distributing an app written in access 2000 runtime but client still uses access 97

12. Referencing Access 2000 Field Names and Values in Word 2000

 

 
Powered by phpBB® Forum Software