ADO

 Keywords: ADO

Much ADO About Recordsets

Stan Littlefield

Much ADO About Recordsets: Updating and Error Handling

This article explores writing Winbatch scripts specific to the ADO Recordset. It assumes some familiarity with ADO and Winbatch errors but does not involve complicated scripting. You may find the error-handling methods applicable to other areas. Several ADO enumerations are listed and have been arranged in csv format for cutting and pasting into your scripts for lookups. All that is required to run any of the code is MDAC 2.5 or higher. MDAC is free and for downloads see http://msdn.microsoft.com/data/ref/mdac/downloads/ When you think Recordset, you see it referring to a table within a database, or the results or an SQL Query. Not nearly as commonplace is the standalone Recordset, a.k.a. in-memory or fabricated Recordset. The benefits of working with this object ; It does not require additional databases or a server. You can examine ADO commands and properties extensible to other data sources An ADO Recordset is simply a matter of definition - oRS=CreateObject("ADODB.Recordset") and activation -oRS.Open(,,1,4,-1). Parameters for creating individual fields with ADO append() method:

a name:required
a data type:required
an optional field length, used for character fields
optional field attributes and
an optional default value for the field.

A simple example

oRS.Fields.Append("name",200,10,)

which creates a character field name with a defined/maximum length of 10 characters. Once a Recordset is activated in this fashion it behaves like any ADO Recordset from a database table source; you can add or modify data. Assuming you have created a Recordset in this fashion, there is really nothing to modify until individual rows are inserted. Since there is no Connection Object in-Memory Recordsets are saved or persisted to files using

oRS.Save( filename, mode)

where filename is a fully-pathed name with extension (either .xml or .adt depending upon the mode) - that cannot already exist! The mode is either 0 or 1: 0=.adt or binary; 1=.xml of ascii. Once saved, the file can be re-opened using the MsPersist Provider included with MDAC. Assume the file was saved as a variable cXML=C:\temp\test.xml)

oRS.Save(cXML,1)

it is then re-opened

oRS.Open(cXML,"Provider=MSPersist;",1,4,256)

At this point you can call oRS.Save() as much as you want without worrying about whether the file exists or not. If you are unfamiliar parameters 3-5 for oRS.Open(), they refer to

Cursortype

adOpenForwardOnly = 0 
adOpenKeyset = 1 
adOpenDynamic = 2 
adOpenStatic = 3

Locking Mode

 
adLockReadOnly = 1 
adLockPessimistic = 2 
adLockOptimistic = 3 
adLockBatchOptimistic = 4

How The Recordset is Obtained (by SQL Command, from table)

adCmdUnspecified = -1 ; Does not specify the command type argument.  
adCmdText = 1 ; Evaluates CommandText as a textual definition of a command or stored procedure call.  
adCmdTable = 2  ; Evaluates CommandText as a table name whose columns are all returned by an internally generated SQL query.  
adCmdStoredProc = 4 ; Evaluates CommandText as a stored procedure name.  
adCmdUnknown = 8 ; Default. Indicates that the type of command in the CommandText property is not known.  
adCmdFile = 256 ; Evaluates CommandText as the file name of a persistently stored Recordset. Used with Recordset. Open or Requery only.  
adCmdTableDirect = 512 ; Evaluates CommandText as a table name whose columns are all returned. Used with Recordset.
		Open or Requery only. To use the Seek method the Recordset must be opened with adCmdTableDirect. This value cannot 
		be combined with the ExecuteOptionEnum value adAsyncExecute

Note: persisting Recordsets is a two way process; in addition to creating from scratch actual tables or queries from existing databases like Access, Oracle, SQL Server can be persisted with oRS.Save() a process known as creating a disconnected recordset. More on this later.

Recordsets and Errors

With this introduction into the creation of in-memory recordsets, consider this simple script

cXML = StrCat(DirScript(),"test.xml")
If FileExist(cXML) Then FileDelete(cXML)
oRS=CreateObject("ADODB.Recordset")
oRS.Fields.Append("name",200,10,)
oRS.Open(,,1,4,-1)
cname="My name is Sue, how do you do"
oRS.Addnew()
oRS.Fields("name").Value = cname
oRS.Update()
oRS.Save(cXML,1)
oRS.Close()
oRS=0
Exit

Run it and it will error.

You know the problem; you tried to stuff more than 10 chars into the name. Sure be nice if the error was more to the point like Data Overflow Error and you cannot summon the ADO Error Object since that is tied to the Connection Object and our Recordset doesn't have one. Initially that leaves the WB Error Handler. You add IntControl(73,1,1,0,0) to the top of your script and at the bottom add a section :WBERRORHANDLER. Of course about all you can do is exit the script a little more gracefully. Or maybe change to IntControl(73,2,1,0,0) and see if the script will recover. (It won't). Assume that rather than the value for name being hard-code, it was being input by a user on a dialog and after input he or she would click an Add Button. You could let the script bomb-out and if and when they called you up about it tell them what an idiot they are; you could put text on the dialog PLEASE: don't enter more than 10 characters; or you could try to re-write :WBERRORHANDLER to say either (1) Oops, you entered too much data, like to try again? (2)Record Could Not Be added because ___________________ . Error handling gets more complicated when you consider

a Recordset generally has more than 1 field
you have to deal with different field types
you design a dialog

for data entry where the user presses an Add Button should/and could you validate each field as the user types on the form or wait until Add is clicked (4) what about Null values, or leaving some fields blank. The error in the script occurs just before oRS.Update(), but after oRS.Addnew(). You would think this might mean you have a blank garbage record, but in actuality ADO buffers the new record and performs two sorts of validation The individual fields are valid (before the update) That even with valid fields, the record does not violate any rules (during the update) The 2nd validation effort can be verified from oRS.Status, called after updating. Possible values are

;record status
adRecCanceled,256,Indicates that the record was not saved because the operation was canceled.
adRecCantRelease,1024,Indicates that the new record was not saved because the existing record was locked.
adRecConcurrencyViolation,2048,Indicates that the record was not saved because optimistic concurrency was in use.
adRecDeleted,4,Indicates that the record was deleted.
adRecIntegrityViolation,4096,Indicates that the record was not saved because the user violated integrity constraints.
adRecInvalid,16,Indicates that the record was not saved because its bookmark is invalid.
adRecMaxChangesExceeded,8192,Indicates that the record was not saved because there were too many pending changes.
adRecModified,2,Indicates that the record was modified.
adRecMultipleChanges,64,Indicates that the record was not saved because it would have affected multiple records.
adRecNew,1,Indicates that the record is new.
adRecObjectOpen,16384,Indicates that the record was not saved because of a conflict with an open storage object.
adRecOK,0,Indicates that the record was successfully updated.
adRecOutOfMemory,32768,Indicates that the record was not saved because the computer has run out of memory.
adRecPendingChanges,128,Indicates that the record was not saved because it refers to a pending insert.
adRecPermissionDenied,65536,Indicates that the record was not saved because the user has insufficient permissions.
adRecSchemaViolation,131072,Indicates that the record was not saved because it violates the structure of the underlying database.
adRecUnmodified,8,Indicates that the record was not modified.

Since our script example is fairly innocuous, we are going to assume an update() would occur is we could get that far. So let's turn our attention to field validation where we discover that ADO includes a field Status:

;field properties 
Property,Description  
ActualSize,Returns the actual length of a field's value  
Attributes,Sets or returns the attributes of a Field object  
DefinedSize,Returns the defined size of a field  
Name,Sets or returns the name of a Field object  
NumericScale,Sets or returns the number of decimal places allowed for numeric values in a Field object  
OriginalValue,Returns the original value of a field  
Precision Sets,or returns the maximum number of digits allowed when representing numeric values in a Field object  
Status, Returns the status of a Field object  
Type,Sets or returns the type of a Field object  
UnderlyingValue,Returns the current value of a field  
Value,Sets or returns the value of a Field object

And possible values for status are:

   
0,The field was successfully added or deleted  
2,The field cannot be retrieved or stored without loss of data  
3,The provider returned a null value  
4,Variable-length data was truncated when reading from the data source  
5,The data value returned by the provider was signed, but the data type of the ADO field value was unsigned  
6,The data returned from the provider overflowed the data type of the field  
7,The field could not be added because the provider exceeded a limitation  
8,The provider could not determine the value when reading from the data source  
9,The field cannot be modified because it is read-only  
10,The field cannot be modified because it is a calculated or derived entity  
11,The value violated the data source schema constraint for the field  
12,An invalid status value was sent from ADO to the OLE DB provider  
13,The default value for the field was used when setting data  
15,This field was skipped when setting data values in the source  
16,The field does not exist  
17,The data source URL contains invalid characters  
18,The provider cannot perform the operation because the data source is locked  
19,The provider cannot perform the operation because an object already exists at the destination URL and it is not able to overwrite the object  
20,The server of the URL specified by Source could not complete the operation  
21,The provider is unable to locate the storage volume indicated by the URL  
22,The provider is unable to obtain enough storage space to complete a move or copy operation  
23,During a move operation, a tree or subtree was moved to a new location, but the source could not be deleted  
24,The field in the data source is read-only  
25,A source or destination URL is outside the scope of the current record  
26,The specified field already exists  
65536,The Append operation caused the status to be set. The field has been marked to be added to the Fields collection after the Update method is called  
131071,The Delete operation caused the status to be set. The field has been marked for deletion from the Fields collection after the Update method is called  
262144,The field has been deleted and then re-added or the value of the field which previously had a status of adFieldOK has changed  
524288,The provider cannot determine what operation caused field status to be set  
1048576,The provider cannot determine what operation caused field status to be set, and that the field will be deleted from the Fields collection after the Update method is called.

If all fields would return a 0 the WB error would not occur. Let's modify our original script to test this. The script refers to FieldStatus.txt, included in the files attached with this article. Next, we will add two UDF's one to parse fieldstatus.txt and the other to evaluate the field input prior issuing an update. Since we want ADO to aid in error recovery we set up the WB Error Handler to simulate VB's ON ERROR GO NEXT:

GoSub udfs
;Note: initial error-handler set to gosub
IntControl(73,2,1,0,0)
gatherstatus()
cXML = StrCat(DirScript(),"test.xml")
If FileExist(cXML) Then FileDelete(cXML)
oRS=CreateObject("ADODB.Recordset")
oRS.Fields.Append("name",200,10)
oRS.Open(,,1,4,-1)
Display(1,"Recordset Created","Adding Data")
cname="My name is Sue, how do you do"
oRS.Addnew()
oRS.Fields("name").Value = cname
; this will fail with error 1261
                                  ; but setting up error-handler as
                                  ; gosub let's us proceed to checkstatus()
If chkstatus(0)
   oRS.update()
   Display(1,"Record Status",oRS.Status)
   oRS.Save(cXML,1)
EndIf
oRS.Close()
oRS=0
Exit
:WBERRORHANDLER
IntControl(73,2,1,0,0)
Return

:udfs
#DefineSubRoutine chkStatus(goodstatus)
;Return(1)
cStatus=""
isOK=1
For i = 0 To (oRS.Fields.Count -1)
   n=oRS.Fields(i).Status
   If n<goodstatus Then isOK=0
   n1=ItemLocate(n,sNum,@TAB)
   If n<0 Then cStatus=StrCat(cStatus,oRS.Fields(i).Name," - Value:",oRS.Fields(i).Value," - ",ItemExtract(n1,sTxt,@TAB),@CRLF)
Next

If !isOK Then Message("Update Status",cStatus)

Return(isOK)
#EndSubRoutine

#DefineSubRoutine gatherStatus()
   cFile= StrCat(DirScript(),"fieldstatus.txt")
   If ! FileExist(cFile) Then Exit
   h=FileOpen(cFile,"READ")
   sNum =""
   sTxt =""
   While 1
      x=FileRead(h)
      If x=="*EOF*" Then Break
      sNum=StrCat(sNum,ItemExtract(1,x,","),@TAB)
      sTxt=StrCat(sTxt,ItemExtract(2,x,","),@TAB)
   EndWhile
   FileClose(h)
   Return(1)
#EndSubRoutine

Return

Which offers more friendly error handling

This information permits you to address each field by its status, and is not only useful for new records but for modifications to existing data. To test further we add a numeric and a logical field.

oRS.Fields.Append("name",200,10)
oRS.Fields.Append("age",131)
oRS.Fields("age").Precision =3
oRS.Fields("age").NumericScale =0
oRS.Fields.Append("isMember",11)

There are several types of numeric data in ADO

;Numeric Field Types 
adCurrency,6,Indicates a currency value. Currency is a fixed-point number with four digits to the right of the decimal point. It is stored in an eight-byte signed integer scaled by 10,000.  
adDecimal,14,Indicates an exact numeric value with a fixed precision and scale.  
adDouble,5,Indicates a double-precision floating-point value.  
adInteger,3,Indicates a four-byte signed integer.  
adNumeric,131,Indicates an exact numeric value with a fixed precision and scale.  
adSingle,4,Indicates a single-precision floating-point value.  
adSmallInt,2,Indicates a two-byte signed integer.  
adTinyInt,16,Indicates a one-byte signed integer.  
adUnsignedInt,19,Indicates a four-byte unsigned integer.  
adUnsignedSmallInt 18 Indicates a two-byte unsigned integer.  
adUnsignedTinyInt,17,Indicates a one-byte unsigned integer.  
adVarNumeric,139,Indicates a numeric value.

We pick 131 so that we can specify a 3 digit number with no Decimal places. This time, let's enter a correct name, but a large number:

oRS.Addnew()
oRS.Fields("name").Value = "Sue"
oRS.Fields("age").Value = 1234
oRS.Fields("isMember").Value = @FALSE

Again, the field status provides useful information. In the final section of the article the script is expanded to include a data entry dialog and the error-handler is coded to recover from invalid data entry.

Successful Update what is in test.xml

If the script were adjusted so that all fields contained valid data then a file test.xml is written which can be opened with any Ascii editor. First, change to oRS.Fields("age").Value = 123 so that test.xml is created. It has the features of a standard xml file; field data is entered as z:rows and each attribute is the name of the field with its associated data. The end of the file should look like

 
<rs:data>
<rs:insert>
<z:row name='Sue' age='123' isMember='False'/>
</rs:insert>
</rs:data>

Although 123 is quoted, it is defined numeric in the schema section of test.xml

<s:AttributeType name='age' rs:number='2' rs:write='true'>
<s:datatype dt:type='number' rs:dbtype='numeric' dt:maxLength='19' rs:scale='0' rs:precision='3' rs:fixedlength='true'
rs:maybenull='false'/>

Note the scale and precision reflect the attributes entered when the field was defined. The maybenull attribute refers to the capacity to read null data from that field. And lacking any sign that nulls are acceptable we will assume that no null data can be entered. To test change

oRS.Fields("age").Value = 123

oRS.Fields("age").Value = ObjectType("NULL","")

and re-run the script.

the message is a little strange but obviously using the status property is still workable. So what if we wanted to allow nulls? This involves the field attributes, the 4th parameter in the append() method..

;attributes
adFldCacheDeferred,4096,Indicates that the provider caches field values and that subsequent reads are done from the cache.
adFldFixed,16,Indicates that the field contains fixed-length data.
adFldIsChapter,8192,Indicates that the field contains a chapter value which specifies a specific child recordset related to this parent field. Typically chapter fields are used with data shaping or filters.
adFldIsCollection,262144,Indicates that the field specifies that the resource represented by the record is a collection of other resources such as a folder rather than a simple resource such as a text file.
adFldIsDefaultStream,131072,Indicates that the field contains the default stream for the resource represented by the record. For example the default stream can be the HTML content of a root folder on a Web site which is automatically served when the root URL is specified.
adFldIsNullable,32,Indicates that the field accepts null values.
adFldIsRowURL,65536,Indicates that the field contains the URL that names the resource from the data store represented by the record.
adFldLong,128,Indicates that the field is a long binary field. Also indicates that you can use the AppendChunk and GetChunk methods.
adFldMayBeNull,64,Indicates that you can read null values from the field.
adFldMayDefer,2,Indicates that the field is deferred—that is the field values are not retrieved from the data source with the whole record but only when you explicitly access them.
adFldNegativeScale,16384,Indicates that the field represents a numeric value from a column that supports negative scale values. The scale is specified by the NumericScale property.
adFldRowID,256,Indicates that the field contains a persistent row identifier that cannot be written to and has no meaningful value except to identify the row (such as a record number unique identifier and so forth).
adFldRowVersion,512,Indicates that the field contains some kind of time or date stamp used to track updates.
adFldUnknownUpdatable,8,Indicates that the provider cannot determine if you can write to the field.
adFldUnspecified,-1,Indicates that the provider does not specify the field attributes.
adFldUpdatable,4,Indicates that you can write to the field.

Multiple attributes are added ( OR'd ). So we can define age as

oRS.Fields.Append("age",131,,32|64)

and run the script and again look at test.xml. Note the attributes for age

<rs:nullable='true' rs:write='true'>

Nullable is added, maybenull removed. More interesting in the data section:

<z:row name='Sue' isMember='False' rs:forcenull='age'/>

Rather than saying age="" a forcenull indicator is used. Assuming we define

oRS.Fields.Append("name",200,10,32|64)

and indicate

oRS.Fields("name").Value = ObjectType("NULL","")
oRS.Fields("age").Value = ObjectType("NULL","")

test.xml shows

<z:row isMember='False' rs:forcenull='name age'/>

Comment the line ;oRS.Fields("isMember").Value = @False and you get

<z:row rs:forcenull='name age'/>

By default logical fields cannot be Null and if ismember were in Access or other database table, it would default to False so why doesn't it default in our Recordset. Try to set a default with

oRS.Fields.Append("isMember",11,,,0)

does not work. This is because the 5th parameter only applies to a ecord object, not a Recordset. More on this in the next section.

Update() and UpdateBatch

Creating our Recordset with a locktype of BatchOptimistic permits both individual and bulk operations, i.e. multiple INSERTS. The script has been using the update() method to add the new record, but could equally have used updatebatch(). While neither affects field validation, they do alter the record status after update the line

Display(1,"Record Status",oRS.Status)

in the script. When using update() the status is adRecNew,1,Indicates that the record is new.

But now change from update() to updatebatch() [keeping the null entries for name and age, and keeping the ismember commented]. The record will be added, but (1) the record status will display 8, adRecUnmodified,8,Indicates that the record was not modified

Try the script with these modifications:

GoSub udfs
;Note: initial error-handler set to gosub
IntControl(73,2,1,0,0)
gatherstatus()
cXML = StrCat(DirScript(),"test.xml")
If FileExist(cXML) Then FileDelete(cXML)
oRS=CreateObject("ADODB.Recordset")
oRS.Fields.Append("name",200,10,32)
oRS.Fields.Append("age",131,,32)
oRS.Fields("age").Precision =3
oRS.Fields("age").NumericScale =0
oRS.Fields.Append("isMember",11)
oRS.Open(,,1,4,-1)
Display(1,"Recordset Created","Adding Data")
oRS.Addnew()
oRS.Fields("name").Value = ObjectType("NULL","")
oRS.Fields("age").Value = ObjectType("NULL","")
;oRS.Fields("isMember").Value = @False
If chkstatus(0)
   oRS.updatebatch()
   Display(1,"Record Status",oRS.Status)
   oRS.Save(cXML,1)
EndIf
oRS.Close()
oRS=0
Exit

:WBERRORHANDLER
IntControl(73,2,1,0,0)
Return

;////////////////////////////////////////////////////////////////////////

:udfs
#DefineSubRoutine chkStatus(goodstatus)
;Return(1)
cStatus=""
isOK=1
For i = 0 To (oRS.Fields.Count -1)
   n=oRS.Fields(i).Status
   If n<goodstatus Then isOK=0
   n1=ItemLocate(n,sNum,@TAB)
   If n<0 Then cStatus=StrCat(cStatus,oRS.Fields(i).Name," - Value:",oRS.Fields(i).Value," - ",ItemExtract(n1,sTxt,@TAB),@CRLF)
Next

Message("Update Status",cStatus)

Return(isOK)
#EndSubRoutine

#DefineSubRoutine gatherStatus()
cFile= StrCat(DirScript(),"fieldstatus.txt")
If ! FileExist(cFile) Then Exit
h=FileOpen(cFile,"READ")
sNum =""
sTxt =""
While 1
   x=FileRead(h)
   If x=="*EOF*" Then Break
   sNum=StrCat(sNum,ItemExtract(1,x,","),@TAB)
   sTxt=StrCat(sTxt,ItemExtract(2,x,","),@TAB)
EndWhile
FileClose(h)
Return(1)
#EndSubRoutine

Return

And test.xml looks like this

<z:row isMember='False'/>

Change updatebatch() to update()

<z:row rs:forcenull='name age'/>

Implications:
We need to test whether the choice of update() or updatebatch(), in spite of differences in output really affect our ability to handle the data once persisted. The script below opens the Recordset and creates a .csv file with field headers which is then displayed in a messagebox.

cXML = StrCat(DirScript(),"test.xml")
If ! FileExist(cXML) Then Exit
oRS=CreateObject("ADODB.Recordset")
oRS.Open(cXML,"Provider=MSPersist;",1,4,256)
Message("RecordCount",oRS.Recordcount)
oRS.MoveFirst()
cTxt = ""
For i = 0 To (oRS.Fields.Count -1)
   cTxt = StrCat(cTxt,oRS.Fields(i).name,",")
Next
cTxt = StrCat(StrSub(cTxt,1,StrLen(cTxt)-1),@CRLF)
cTxt = StrCat(cTxt,oRS.GetString(, , ",", @CRLF))
Message("Data",cTxt)
oRS.Close()
oRS=0
Exit

With updatebatch()

with update()

Once the data is in csv the ismember field type is lost and would be treated as a null in the file produced by update() rather than @False as produced by updatebatch(). In the test.xml created by either update method, ismember is treated correctly.

Moving to a Dialog

The script that follows initializes Recordset and 3 fields but allows inputting multiple rows by use of a simple dialog. Invalid field entries are handled by the field status UDF. Moving to a script that involves user input involves re-thinking the WB Error Handler. While initially set as a gosub, it is changed to a goto upon exiting the dialog to determine errors occurring while persisting the data. Were the dialog to utilize a callback procedure you would encapsulate :WBERRORHANDLER within the procedure.

GoSub udfs
errgosub=1
IntControl(73,2,1,0,0)
gatherstatus()
cXML = StrCat(DirScript(),"test.xml")
If FileExist(cXML) Then FileDelete(cXML)
oRS=CreateObject("ADODB.Recordset")
oRS.Fields.Append("name",200,10,32|64)
oRS.Fields.Append("age",131,,32|64)
oRS.Fields("age").Precision =2
oRS.Fields("age").NumericScale =0
oRS.Fields.Append("isMember",11)
oRS.Open(,,1,4,-1)
newRec=1

:start
If newRec
   cName = ""
   nAge =  ""
   lMember = 0
EndIf

RFormat=`WWWDLGED,6.1`
RCaption=`Test Add Record`
RX=9999
RY=9999
RWidth=146
RHeight=071
RNumControls=007
RProcedure=`DEFAULT`
RFont=`DEFAULT`
RTextColor=`DEFAULT`
RBackground=`DEFAULT,DEFAULT`
RConfig=0
R001=`097,025,036,012,PUSHBUTTON,DEFAULT,"Add",1,4,32,DEFAULT,DEFAULT,DEFAULT`
R002=`097,045,036,012,PUSHBUTTON,DEFAULT,"Quit",2,5,DEFAULT,DEFAULT,DEFAULT,DEFAULT`
R003=`007,007,044,012,STATICTEXT,DEFAULT,"Name",DEFAULT,6,DEFAULT,DEFAULT,DEFAULT,DEFAULT`
R004=`007,027,044,012,STATICTEXT,DEFAULT,"Age",DEFAULT,7,DEFAULT,DEFAULT,DEFAULT,DEFAULT`
R005=`007,047,080,012,CHECKBOX,lMember,"Is This Person a Member",1,3,DEFAULT,DEFAULT,DEFAULT,DEFAULT`
R006=`065,005,068,012,EDITBOX,cName,DEFAULT,DEFAULT,1,DEFAULT,DEFAULT,DEFAULT,DEFAULT`
R007=`065,025,024,012,EDITBOX,nAge,DEFAULT,DEFAULT,2,DEFAULT,DEFAULT,DEFAULT,DEFAULT`
BP=Dialog("R")

If BP==2 Then Goto End

If (cName=="" && nAge=="" && !lMember) Then Goto Start
oRS.Addnew()
oRS.Fields("name").Value = cName
If nAge==""
   oRS.Fields("age").Value = ObjectType("NULL","")
Else
   oRS.Fields("age").Value = nAge
EndIf
oRS.Fields("ismember").Value = lMember
If chkstatus(0)
   oRS.update()
   newRec=1
Else
   oRS.CancelUpdate()
   newRec=0
EndIf
Goto start
:End
errgosub=0
IntControl(73,1,1,0,0)
oRS.Save(cXML,1)
oRS.Close()
oRS=0
Exit

:WBERRORHANDLER
If errgosub
   IntControl(73,2,1,0,0)
   Return
Else
   Display(2,"An Error Has Occured Saving The Recordset",LastError())
   oRS=0
   Exit
EndIf

:udfs
#DefineSubRoutine chkStatus(goodstatus)
cStatus=""
isOK=1
For i = 0 To (oRS.Fields.Count -1)
   n=oRS.Fields(i).Status
   If n<goodstatus Then isOK=0
   n1=ItemLocate(n,sNum,@TAB)
   If n<goodstatus Then cStatus=StrCat(cStatus,"Invalid Entry in [",oRS.Fields(i).Name,"] ",oRS.Fields(i).Value," - ",ItemExtract(n1,sTxt,@TAB),@CRLF)
Next

If !isOK Then Message("Unable To Update",cStatus)


Return(isOK)
#EndSubRoutine

#DefineSubRoutine gatherStatus()
cFile= StrCat(DirScript(),"fieldstatus.txt")
If ! FileExist(cFile) Then Exit
h=FileOpen(cFile,"READ")
sNum =""
sTxt =""
While 1
   x=FileRead(h)
   If x=="*EOF*" Then Break
   sNum=StrCat(sNum,ItemExtract(1,x,","),@TAB)
   sTxt=StrCat(sTxt,ItemExtract(2,x,","),@TAB)
EndWhile
FileClose(h)
Return(1)
#EndSubRoutine

Return

A neat trick with a Fabricated Recordset

As was mentioned, persisted recordsets can also represent the results of a query or table in a database. Assume for an instant that the three fields we have been working with were a table in Microsoft Access.

You would persist them with

cMDB = StrCat(DirScript(),"ado.mdb")
If !FileExist(cMDB) Then Exit
cXML = StrCat(DirScript(),"testtable.xml")
If FileExist(cXML) Then FileDelete(cXML)
cConn = "Provider=MicroSoft.Jet.OLEDB.4.0; Data Source=%cMDB%"
oRS=CreateObject("ADODB.Recordset")
oRS.Open("TestTable",cConn,1,4,2)
oRS.Save(cXML,1)
oRS.Close()
oRS=0
Exit

Using Keyset and BatchOptimistic - 1,4 is important as it persists the information about the table each field came from in the xml schema. For example, the name field

<s:AttributeType name='name' rs:number='1' rs:maydefer='true' rs:write='true' rs:basetable='TestTable'
rs:basecolumn='name'><s:datatype dt:type='string' dt:maxLength='10'/>
</s:AttributeType>

By including basecolumn, basetable and setting maydefer=true, any changes made to this recordset and re-persisted to the xml file can be automatically updated to the original Access table with updatebatch(). This use of disconnected Recordsets is valuable in situations with limited Server licenses i.e. it would allow 25 users to access data tables on a server with 10 licenses; each briefly connects, persists their query, disconnects, works on their data, and performs an updatebatch(). There is a lot more to it than can be explored here, so let's return to our fabricated Recordset. A question:

You create and persist a Recordset and add hundreds of rows; is there an easy way to turn that data into an Access Table?

Well, not easy, but certainly not difficult. BaseColumn and basetable are not properties or attributes, although maydefer is. If you want your Recordset to become an Access Table (this may work with other providers dependent upon their allowable data types) first include maydefer [2] in each field definition.

oRS.Fields.Append("name",200,10,2|32|64)
oRS.Fields.Append("age",131,,2|32|64)
oRS.Fields("age").Precision =3
oRS.Fields("age").NumericScale =0
oRS.Fields.Append("isMember",11,,2)

Next, you would just open and save the database without adding any records, but save the field names to a csv string variable. Then open the file with WB's fileget(), insert a few lines and re-save. When the file is opened again as a persisted recordset and records are added, a simple subroutine that involves ADOX can transfer the Recordset to an Access table. The following script [MuchADO.wbt] runs through the entire process, from Recordset Creation to transfer to Access and incorporates most of the code snippets presented. Please look at the comments in the UDS transfertoaccess() as it points to several difficulties involving data types.

FieldStatus.txt

0,The field was successfully added or deleted 
2,The field cannot be retrieved or stored without loss of data 
3,The provider returned a null value 
4,Variable-length data was truncated when reading from the data source 
5,The data value returned by the provider was signed, but the data type of the ADO field value was unsigned 
6,The data returned from the provider overflowed the data type of the field 
7,The field could not be added because the provider exceeded a limitation 
8,The provider could not determine the value when reading from the data source 
9,The field cannot be modified because it is read-only 
10,The field cannot be modified because it is a calculated or derived entity 
11,The value violated the data source schema constraint for the field 
12,An invalid status value was sent from ADO to the OLE DB provider 
13,The default value for the field was used when setting data 
15,This field was skipped when setting data values in the source 
16,The field does not exist 
17,The data source URL contains invalid characters 
18,The provider cannot perform the operation because the data source is locked 
19,The provider cannot perform the operation because an object already exists at the destination URL and it is not able to overwrite the object 
20,The server of the URL specified by Source could not complete the operation 
21,The provider is unable to locate the storage volume indicated by the URL 
22,The provider is unable to obtain enough storage space to complete a move or copy operation 
23,During a move operation, a tree or subtree was moved to a new location, but the source could not be deleted 
24,The field in the data source is read-only 
25,A source or destination URL is outside the scope of the current record 
26,The specified field already exists 
65536,The Append operation caused the status to be set. The field has been marked to be added to the Fields collection after the Update method is called 
131071,The Delete operation caused the status to be set. The field has been marked for deletion from the Fields collection after the Update method is called 
262144,The field has been deleted and then re-added or the value of the field which previously had a status of adFieldOK has changed 
524288,The provider cannot determine what operation caused field status to be set 
1048576,The provider cannot determine what operation caused field status to be set, and that the field will be deleted from the Fields collection after the Update method is called.

MuchADO.wbt

;Winbatch 2006B
;This script accompanies a PDF article "Much ADO About Recordsets: Updating and Error Handling"
;
;It will (1) create a fabricated recordset with 3 fields
;        (2) modify the recordset schema to allow transfer to Access
;        (3) open a dialog so you can input sample records
;        (4) transfer the table to an Access Table in a
;            newly created ado.mdb file
;
;Stan Littlefield, May 11, 2006
;//////////////////////////////////////////////////////////////////////////////////////////////
GoSub udfs
errgosub=1
IntControl(73,2,1,0,0)
gatherstatus()
;name of Table when data transferred to Access
cTable = "TestTable"
cXML = StrCat(DirScript(),"test.xml")
If FileExist(cXML) Then FileDelete(cXML)
oRS=CreateObject("ADODB.Recordset")
oRS.Fields.Append("name",200,10,2|32|64)
oRS.Fields.Append("age",131,,2|32|64)
oRS.Fields("age").Precision =3
oRS.Fields("age").NumericScale =0
oRS.Fields.Append("isMember",11,,2)
oRS.Open(,,1,4,-1)
;quickly make changes so Recordset can update to Access
updateschema()
newRec=1

;data entry dialog
:start
If newRec
   cName = ""
   nAge =  ""
   lMember = 0
EndIf

RFormat=`WWWDLGED,6.1`
RCaption=`Data Entry Dialog`
RX=9999
RY=9999
RWidth=146
RHeight=071
RNumControls=007
RProcedure=`DEFAULT`
RFont=`DEFAULT`
RTextColor=`DEFAULT`
RBackground=`DEFAULT,DEFAULT`
RConfig=0
R001=`097,025,036,012,PUSHBUTTON,DEFAULT,"Add",1,4,32,DEFAULT,DEFAULT,DEFAULT`
R002=`097,045,036,012,PUSHBUTTON,DEFAULT,"Quit",2,5,DEFAULT,DEFAULT,DEFAULT,DEFAULT`
R003=`007,007,044,012,STATICTEXT,DEFAULT,"Name",DEFAULT,6,DEFAULT,DEFAULT,DEFAULT,DEFAULT`
R004=`007,027,044,012,STATICTEXT,DEFAULT,"Age",DEFAULT,7,DEFAULT,DEFAULT,DEFAULT,DEFAULT`
R005=`007,047,080,012,CHECKBOX,lMember,"Is This Person a Member",1,3,DEFAULT,DEFAULT,DEFAULT,DEFAULT`
R006=`065,005,068,012,EDITBOX,cName,DEFAULT,DEFAULT,1,DEFAULT,DEFAULT,DEFAULT,DEFAULT`
R007=`065,025,024,012,EDITBOX,nAge,DEFAULT,DEFAULT,2,DEFAULT,DEFAULT,DEFAULT,DEFAULT`
BP=Dialog("R")
If BP==2 Then Goto End

If (cName=="" && nAge=="" && !lMember) Then Goto Start
oRS.Addnew()
oRS.Fields("name").Value = cName
If nAge==""
   oRS.Fields("age").Value = ObjectType("NULL","")
Else
   oRS.Fields("age").Value = nAge
EndIf
oRS.Fields("ismember").Value = lMember
If chkstatus(0)
   oRS.update()
   newRec=1
Else
   oRS.CancelUpdate()
   newRec=0
EndIf
Goto start
:End
errgosub=0
IntControl(73,1,1,0,0)

If oRS.RecordCount==0
   Display(1,"Finished...","No Records Entered")
   oRS.Close()
   oRS=0
Else
   Display(1,"Finished...","Transferring To Access")
   oRS.Save(cXML,1)
   oRS.MoveFirst()
   transfertoaccess()
EndIf

Exit

:WBERRORHANDLER
If errgosub
   IntControl(73,2,1,0,0)
   Return
Else
   Message("An Error Has Occured Saving The Recordset",LastError())
   oRS=0
   Exit
EndIf

:udfs
#DefineSubRoutine chkStatus(goodstatus)
cStatus=""
isOK=1
For i = 0 To (oRS.Fields.Count -1)
   n=oRS.Fields(i).Status
   If n<>goodstatus Then isOK=0
   n1=ItemLocate(n,sNum,@TAB)
   If n<>goodstatus Then cStatus=StrCat(cStatus,"Invalid Entry in [",oRS.Fields(i).Name,"] ",oRS.Fields(i).Value," - ",ItemExtract(n1,sTxt,@TAB),@CRLF)
Next

If !isOK Then Message("Unable To Update",cStatus)


Return(isOK)
#EndSubRoutine

#DefineSubRoutine gatherStatus()
cFile= StrCat(DirScript(),"fieldstatus.txt")
If ! FileExist(cFile)
   Display(1,"Status Lookup Missing",cFile)
   Exit
EndIf
h=FileOpen(cFile,"READ")
sNum =""
sTxt =""
While 1
   x=FileRead(h)
   If x=="*EOF*" Then Break
   sNum=StrCat(sNum,ItemExtract(1,x,","),@TAB)
   sTxt=StrCat(sTxt,ItemExtract(2,x,","),@TAB)
EndWhile
FileClose(h)
Return(1)
#EndSubRoutine

#DefineSubRoutine updateschema()
oRS.Save(cXML,1)
oRS.Close()
oRS.Open(cXML,"Provider=MSPersist;",1,4,256)
flds=""
n= oRS.Fields.Count
For i = 0 To (n -1)
   flds = StrCat(flds,oRS.Fields(i).name,",")
Next
flds = StrCat(StrSub(flds,1,StrLen(flds)-1))
oRS.Close()

cFix = FileGet(cXML)
tbl = StrCat(" rs:basetable='",cTable,"' ")

For i=1 To n
   var = StrCat("name='",ItemExtract(i,flds,","),"' ")
   col = StrCat("rs:basecolumn='",ItemExtract(i,flds,","),"'")
   cFix = StrReplace(cFix,var,StrCat(var,col,tbl))
Next

FilePut(cXML,cFix)
oRS.Open(cXML,"Provider=MSPersist;",1,4,256)
Return(1)
#EndSubRoutine


#DefineSubRoutine transfertoaccess()
cMDB = StrCat(DirScript(),"ado.mdb")
If FileExist(cMDB) Then FileDelete(cMDB)
cConn = "Provider=MicroSoft.Jet.OLEDB.4.0; Data Source=%cMDB%"
oCAT = CreateObject("ADOX.Catalog")
oTBL = CreateObject("ADOX.Table")
oCat.Create(cConn)
oCat.ActiveConnection = cConn
oTBL.ParentCatalog=oCAT
oTBL.Name=cTable
For i = 0 To (oRS.Fields.Count -1)
   name = oRS.Fields(i).Name
   typ =  oRS.Fields(i).Type
   size = oRS.Fields(i).DefinedSize

   ;NOTE: ADOX cannot append a table with columns created
   ;using certain data types. So 200 becomes 202 and type
   ;131 is required to have Precision and Scale transferred
   ;otherwise, you could change type 131 to type 5 [adDouble]
   If typ==200 Then typ=202
   oTBL.Columns.Append(name,typ,size)
   oTBL.Columns.(i).ParentCatalog = oCAT

   ;Remember, we made the Recordset Fields Nullable, so we AND that
   ;Attribute and if True set the column attributes to nullable
   If (oRS.Fields(i).Attributes & 32 )  Then oTBL.Columns.(i).Attributes =2

   ;This adjusts the properties for our number field
   If typ==131
      oTBL.Columns.(i).Precision = oRS.Fields(i).Precision
      oTBL.Columns.(i).NumericScale = oRS.Fields(i).NumericScale
   EndIf
Next
oCAT.Tables.Append(oTBL)
oTBL=0
oCAT=0

;table is created, create a Connection
;we can associate the Recordset with
;issuing updatebatch() should transfer all records
;NOTE: there is always a possibility of error during
;updatebatch(), which is a separate error-handling issue.
oDB=CreateObject("ADODB.Connection")
oDB.Open(cConn)
oRS.ActiveConnection = oDB
oRS.UpdateBatch()
oRS.Close()
oRS=0
oDB.Close()
oDB=0
If FileExist(cMDB) Then Message("Check for Table/Data in...",cMDB)
Return(1)
#EndSubRoutine


Return
;/////////////////////////////////////////////////////////////////////////////

Next time I hope to look at using Regular Expressions in data validation, and creating custom pseudo-field types such as Phone Number, Social Security Number, email address and IP address.

Article ID:   W17360

File Created: 2019:08:14:08:51:54

Last Updated: 2019:08:14:08:51:54

Database Search

TechHome

ADO