dbFailOnError [DAO]

option explicit

public sub execute_error()

  dim mdb_file_name as string
  dim access        as new access.application
  dim db            as dao.database

  mdb_file_name = "c:\\temp\\execute_error_test.mdb"

  set db = create_mdb(access, mdb_file_name)
  call create_schema(db)
  call fill_schema  (db)

  delete_record_with_dependant db, 1, false
  delete_record_with_dependant db, 2, true

end sub

private function create_mdb(access as access.application, mdb_file_name as string) as dao.database

  kill_file_if_exists(mdb_file_name)

  set create_mdb = access.DBEngine.Workspaces(0).CreateDatabase(mdb_file_name, dbLangGeneral, 0)

end function

private sub create_schema(db as dao.database)

  db.execute(                                    _
    "create table tblPARENT ("                 & _
    "  id    number primary key,"              & _
    "  col_1 text"                             & _
    ")"                                          _
  )

  db.execute(                                    _
    "create table tblCHILD ("                  & _
    "  id    number primary key,"              & _
    "  id_p  number references tblPARENT(id)," & _
    "  col_2 text"                             & _
    ")"                                          _
  )


end sub

private sub delete_record_with_dependant(db as dao.database, id as integer, with_db_fail as boolean)

  on error goto exec_err

    dim sqlText as string
  
    sqlText = "delete from tblPARENT where id = " & id
  
    if with_db_fail then
       db.execute sqlText, dbFailOnError
    else
       db.execute sqlText
    end if

    msgBox "no Error occured for id " & id & " " & with_db_fail

  exit sub

  exec_err:
    msgBox "Error " & err.number & " (" & err.description & ") occured for id "  & id & " " & with_db_fail

end sub

private sub fill_schema(db as dao.database)

  db.execute("insert into tblPARENT values (1, 'one')        ")
  db.execute("insert into tblPARENT values (2, 'two')        ")
  db.execute("insert into tblPARENT values (3, 'three')      ")

  db.execute("insert into tblCHILD  values (1, 1, 'un')      ")
  db.execute("insert into tblCHILD  values (2, 1, 'eins')    ")

  db.execute("insert into tblCHILD  values (3, 2, 'deux')    ")
  db.execute("insert into tblCHILD  values (4, 2, 'zwei')    ")

  db.execute("insert into tblCHILD  values (5, 3, 'trois')   ")
  db.execute("insert into tblCHILD  values (6, 3, 'drei')    ")

  ' Following execute doesn't fail although foreign key 4 is not primary key in tblCHILD
  db.execute("insert into tblCHILD  values (7, 4, 'quattre') ")

end sub

private sub kill_file_if_exists(file_name as string)

  dim fso       as fileSystemObject 

  set fso   = new fileSystemObject

  if fso.fileExists(file_name) then
     fso.deletefile(file_name)
  end if

end sub