CodeItBetter Programming Another VB Programming Blog

'Database - How to use a INSERT INTO statement in ADO to copy data from one table into two existing tables
'This example copies data from one table into two existing tables to normalize
'the data. The Combined table has the fields ID, FirstName, LastName, StartTime,
'StopTime, and Rate. The program splits this into a People table with fields ID,
'FirstName, LastName, and Rate; and an Invoices table with fields ID, StartTime,
'and StopTime.

'When you click the Split Table button, the program uses the following code to
'split the table. It executes INSERT INTO statements to copy data from the
'original table into the existing tables. The embedded SELECT statement picks
'the data to be inserted.

Private Sub cmdSplitTable_Click()
    Dim conn As ADODB.Connection
 
    ' Open a connection.
    Set conn = New ADODB.Connection
    conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & m_DbName & ";" _
        & "Persist Security Info=False"
    conn.Open
 
    ' Copy the data from the combined table into the new
    ' tables.
    conn.Execute "INSERT INTO People " & "SELECT DISTINCT ID, FirstName, LastName, Rate " & _
        "FROM Combined"
    conn.Execute "INSERT INTO Invoices " & "SELECT ID, StartTime, StopTime " & "FROM Combined"
 
    ' Display the new data.
    txtData.Text = DBContents(conn)
    conn.Close
End Sub
 
'The program uses the following functions to display the database's contents.
'Function DBContents opens the database's schema to get a list of its tables.
'Then for each table it calls function TableContents.

'Function TableContents selects all of the records from a table and loops
'through them, adding each to its result string.

'Return a string containing the database's contents.
Private Function DBContents(ByVal conn As ADODB.Connection) As String
    Dim rs As ADODB.Recordset
    Dim txt As String
 
    ' Get table information.
    Set rs = conn.OpenSchema(adSchemaTables, Array(Empty, Empty, Empty, "Table"))
    txt = ""
    Do While Not rs.EOF
        ' Get this table's contents.
        txt = txt & TableContents(conn, rs!table_name)
        rs.MoveNext
    Loop
    rs.Close
 
    DBContents = txt
End Function
 
' Return a string containing this table's contents.
Private Function TableContents(ByVal conn As ADODB.Connection, ByVal table_name As String) As String
    Dim rs As ADODB.Recordset
    Dim txt As String
    Dim record_txt As String
    Dim i As Integer
 
    Set rs = conn.Execute("SELECT * FROM " & table_name, , adCmdText)
    txt = "********************" & vbCrLf & table_name & vbCrLf
    Do Until rs.EOF
        record_txt = rs.Fields(0).Value
        For i = 1 To rs.Fields.Count - 1
            record_txt = record_txt & ", " & rs.Fields(i).Value
        Next i
        txt = txt & record_txt & vbCrLf
 
        rs.MoveNext
    Loop
    rs.Close
 
    TableContents = txt
End Function