Procedure CancelUpdates

Description

Cancels any changes made during the update.

Example

Option Explicit

Sub Main()

' General script info

MsgBox ScriptEngineMajorVersion & ScriptEngineminorversion

' Declare all variables

Dim Qry

Dim quDefaultValue

Dim quCustomer

Dim appAccess

Dim dbsCustomer

Dim rsCustomers

Dim Counter

Dim fldDefaultValue

' Create an instance of ACCESS

Set appAccess = CreateObject("Access.Application")

' Open the database supplied by the customer

Set dbsCustomer = appAccess.DBEngine.OpenDatabase("CustDB.mdb", False, True)

' Open the Customer table of the customer

Set rsCustomers = dbsCustomer.OpenRecordset("Customers")

' Check whether the table contains records

If Not rsCustomers.EOF then

Counter = 0

' Retrieve the record containing the default values

Qry = "ip_sel_DefaultValueRecord @DefValueCode = 1"

Set quDefaultValue = Application.DataBase.CreateQuery( Qry )

quDefaultValue.Open

' To prevent pending results, set the values in the Var list

For Each fldDefaultValue In quDefaultValue.Fields

Application.Vars(fldDefaultValue.Name) = fldDefaultValue.Value

Next

' Close the DefaultValue query

quDefaultValue.Close

Set quDefaultValue = Nothing

' Retrieve an empty Customer record, to carry out inserts

Set quCustomer = Application.DataBase.CreateUpdateQuery("Customer", "Customer")

quCustomer.SQL = "ip_sel_CustomerRecord @CustId = ''"

quCustomer.Open

While not rsCustomers.EOF

' Add an empty record to insert data

quCustomer.Insert

' Enter the fields supplied by the customer database

' KeyFields always in capitals!

quCustomer("CustId").Value = UCase(rsCustomers("CustomerNumber"))

quCustomer("Name").Value = rsCustomers("Name")

quCustomer("Addr").Value = rsCustomers("Address")

quCustomer("City").Value = rsCustomers("City")

' Enter the fields that can be retrieved from the DefaultValue

quCustomer("PaymTermCode").Value = Application.Vars("PaymTermCode")

quCustomer("PaymTermCodeDefInd").Value = true

quCustomer("DelTermCode").Value = Application.Vars("DelTermCode")

quCustomer("DelTermCodeDefInd").Value = true

quCustomer("CountryCode").Value = Application.Vars("CountryCode")

quCustomer("LangCode").Value = Application.Vars("LangCode")

quCustomer("CurrCode").Value = Application.Vars("CurrCode")

quCustomer("CurrCodeDefInd").Value = true

quCustomer("PriceListCode").Value = Application.Vars("CustPriceListCode")

quCustomer("GrpCode").Value = Application.Vars("CustGrpCode")

quCustomer("ShipAgentCode").Value = Application.Vars("ShipAgentCode")

quCustomer("ShipAgentCodeDefInd").Value = true

quCustomer("Seller").Value = Application.Vars("Seller")

quCustomer("SellerDefInd").Value = true

quCustomer("QuotLayCode").Value = Application.Vars("QuotLayCode")

quCustomer("QuotLayCodeDefInd").Value = true

quCustomer("SalesOrdConfDocLayCode").Value = Application.Vars("SalesOrdConfDocLayCode")

quCustomer("SalesOrdConfDocLayCodeDefInd").Value = true

quCustomer("ShipDocLayCode").Value = Application.Vars("ShipDocLayCode")

quCustomer("ShipDocLayCodeDefInd").Value = true

quCustomer("InvLayCode").Value = Application.Vars("InvLayCode")

quCustomer("InvLayCodeDefInd").Value = true

quCustomer("ShipDocCreCode").Value = Application.Vars("ShipDocCreCode")

quCustomer("ShipDocCreCodeDefInd").Value = true

quCustomer("InvCreCode").Value = Application.Vars("InvCreCode")

quCustomer("InvCreCodeDefInd").Value = true

quCustomer("SalesOrdConfInd").Value = Application.Vars("SalesOrdConfInd")

' Since booleans and numbers cannot be NULL, enter a default

quCustomer("VATSrchInd").Value = false

quCustomer("SendToFinInd").Value = false

quCustomer("SalesOrdConfInd").Value = true

' This field is invisible but still has to be entered

quCustomer("Balance").Value = 0

' Enter a number of values that the customer wants as defaults

quCustomer("CredLimit").Value = 10000

' Commit the new record to the Isah database

' Turn on error handling

on error resume next

quCustomer.Post

' Check whether an error occurred

If Err.Number <> 0 then

msgbox "Error" & err.description

quCustomer.CancelUpdates

err.clear

end if

' Turn off error handling

on error goto 0

' Another record has been converted

Counter = Counter + 1

' Go to next record to convert

rsCustomers.MoveNext

end

' Close the Customer query

quCustomer.Close

Set quCustomer = Nothing

if Counter <> 1 then

MsgBox & Teller & " records converted"

else

MsgBox "1 record converted"

end if

else

MsgBox "No records to convert"

end if

' Close the Customers record set

rsCustomers.Close

Set rsCustomers = Nothing

' Close the Customer database

dbsCustomer.Close

Set dbsCustomer = Nothing

' Close the instance of the ACCESS application

appAccess.Quit

Set appAccess = Nothing

End Sub