ETL Extract/Transform/Load

Example with 2 Dimension tables: Product Dimension, Seminar Dimension tables
Dim rsProduct As ADODB.Recordset
Dim rsSeminar As ADODB.Recordset
1. Extract Information From Tables using select Statement

Private Sub cmbExtract_Click

Dim cn As New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & CurrentProject.Path & "\NameofDatabaseBackEnd.accdb;"


Set rsProduct = New ADODB.Recordset
With rsProduct
    Set .ActiveConnection = cn
    .Source = "Select * From Product"
    .CursorType = adOpenStatic
    .Open
End With

Set rsSeminar = New ADODB.Recordset
With rsSeminar
    Set .ActiveConnection = cn
        .Source = "Select * from Seminar"
        .CursorType = adOpenStatic
        .Open
End With

Set cn = Nothing

End Sub

2. Transform the data (if need be/any) Then load the data into the new Data Warehouse:

(Set the connection to the Warehouse!!!)

Private Sub cmbTransform_Click()

Dim cnwh As New ADODB.Connection

cnwh.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _

"Data Source=" & CurrentProject.Path & "\NameofDataWarehouse.accdb;"

Dim rsProductwh As ADODB.Recordset

Set rsProductwh = New ADODB.Recordset

    Set rsProductwh.ActiveConnection = cnwh

    

Dim strInsert2 As String

rsProduct.MoveFirst

Do While Not rsProduct.EOF

    strInsert2 = "insert into ProductDim (ProductNumber, Description, UnitPrice)" & _

 " values ('" & rsProduct!ProductNumber & "','" & rsProduct!Description & "','" & rsProduct!Unitprice & "')"

    

    rsProductwh.Open strInsert2

    

    rsProduct.MoveNext

Loop

Set rsProductwh = Nothing

Dim rsSeminarwh As ADODB.Recordset

Set rsSeminarwh = New ADODB.Recordset

    Set rsSeminarwh.ActiveConnection = cnwh

Dim strInsert3 As String

rsSeminar.MoveFirst

Do While Not rsSeminar.EOF

    strInsert3 = "insert into SeminarDim (SeminarDate, SeminarTime, Location, Title)" & _

" values ('" & rsSeminar!SeminarDate & "','" & rsSeminar!SeminarTime & "','" & rsSeminar!Location & "','" & rsSeminar!SeminarTitle & "')"

    

    rsSeminarwh.Open strInsert3

    rsSeminar.MoveNext

Loop

Set cnwh = Nothing ' close the connection

Set rsSeminarwh = Nothing

End Sub