Sub Main
  Set oConn = CreateObject("ADODB.Connection")
  DoTransAction
  Set oConn = nothing
End Sub

Sub DoTransAction()

  On Error Resume Next

  oConn.ConnectionString = "Provider=SLXOLEDB.1assword=ersist Security Info=True;User ID=lee;Initial Catalog=SLXEVAL62;Data Source=scarnie03;Extended Properties=""PORT=1707;LOG=ON"""

  oConn.CursorLocation = adUseClient
  oConn.Open

  Dim bOk' as Boolean
  bOk = true

  ' start a transaction
  oConn.BeginTrans
MsgBox "Here"& Err
  ' create our opportunity record
  Dim oRS_Opportunity ' as ADODB.Recordset

  Set oRS_Opportunity = CreateObject("ADODB.Recordset")
  oRS_Opportunity.LockType = adLockBatchOptimistic
  oRS_Opportunity.CursorType = adOpenStatic

  Dim sSQL ' as String
  sSQL = "SELECT * FROM OPPORTUNITY WHERE 1=2"
  oRS_Opportunity.Open sSQL, oConn

  Dim sOpportunityKey ' as String
MsgBox "Here2"
  oRS_Opportunity.AddNew
  With oRS_Opportunity
    sOpportunityKey = NewKeyFor("OPPORTUNITY")
    .Fields("OPPORTUNITYID").Value = sOpportunityKey
    .Fields("ACCOUNTID").Value = "A1"            ' dummy
    .Fields("SECCODEID").Value = "SYST00000001"  ' everyone
    .Fields("DESCRIPTION").Value = "My new opp"
  End With

  Dim oRS_OppProduct' as ADODB.Recordset

  Set oRS_OppProduct = CreateObject("ADODB.Recordset")
  oRS_OppProduct.LockType = adLockBatchOptimistic
  oRS_OppProduct.CursorType = adOpenStatic

  sSQL = "SELECT * FROM OPPORTUNITY_PRODUCT WHERE 1=0"
  oRS_OppProduct.Open sSQL, oConn

  Dim sOppProductKey ' as String
  Dim iLoop' as Integer

  For iLoop = 0 to 5
    oRS_OppProduct.AddNew
    With oRS_OppProduct
      sOppProductKey = NewKeyFor("OPPORTUNITY_PRODUCT")
      .Fields("OPPPRODUCTID").Value = sOppProductKey
      .Fields("OPPORTUNITYID").Value = sOpportunityKey
      .Fields("PRODUCTID").Value = "A" & iLoop    ' dummy
      .Fields("QUANTITY").Value = iLoop
      .Fields("PRICE").Value = 12.50 * iLoop
    End With
  Next
MsgBox "Here3: " & Err
  ' post all records
  oRS_OppProduct.UpdateBatch
  If Err <> 0 Then
    MsgBox "Error updating Opportunity Product: " & Err.number & ", Msg: " & Err.Description
    bOk = false
  End If

  oRS_Opportunity.UpdateBatch
  If Err <> 0 Then
    MsgBox "Error updating Opportunity: " & Err.number & ", Msg: " & Err.Description
    bOk = false
  End If

  ' clean up code
  Dim bResult' as Boolean
  bResult = MsgBox("OpportunityID: " & sOpportunityKey, vbYesNo, "Commit transaction?")
  If bResult = vbNo or not bOk Then
    oConn.RollbackTrans
  Else
    oConn.CommitTrans
  End If

  oRS_Opportunity = nothing
  oConn = nothing
End Sub