ADO Recordets via OLE - Update Example (OpenInsight 32-Bit)
At 10 NOV 2005 02:02:41PM Bob Carten wrote:
Works Members:
OI 7.2 offers improved OLE functionality, I have been experimenting with updating an SQL server database using ADO recordsets. The example code below shows how to add a new row to a table ith an identity key, then update that using an FM delimited record. I think this is pretty useful. I also found a set of Equates for all the ADO constants, which I translated to OI syntax.
The code for the program appears below, as does the equate.
HTH
Bob
subroutine Ado_Identity_Update(method, Param1, Param2, Param3, Param4)
$Insert Microsoft_Ado_Equates
$Insert Logical
Equ tab$ To \09\
Declare Subroutine Set_Status
counter='
* Ole Objs
rsCreate='
rs='
cmd='
fields='
this_field='
if assigned(method) else method='
if assigned(param1) then p1=param1 else p1='
if assigned(param2) then p2=param2 else p2='
if assigned(param3) then p3=param3 else p3='
if assigned(param4) then p4=param4 else p4='
common /ado_identity_common/conn
if assigned(conn) else conn='
retval='
equ methods$ to 'UPDATE CONNECT DISCONNECT'
Locate method In methods$ using ' ' setting pos then
On pos Gosub Update, Connect, Disconnectend
return retval
Connect:
/*
Connect to server */ ConnectionString=P1 if ConnectionString else * For testing – hard coded. Should be a lookup, or integrated authentication * change as needed SqlServer=localhost" dbName=mydb" dbUserName=sa" dbPassword=" ConnectionString=Provider=SQLOLEDB.1; Network Library=dbmssocn;" ConnectionString := "Password= : dbPassword ConnectionString := ";User : dbUserName ConnectionString := ";Initial Catalog=:DBName ConnectionString := ";Data Source=: SQLServer end conn=OleCreateInstance("ADODB.Connection") OlePutProperty(conn, 'MODE', adModeShareDenyNone) OlePutProperty(conn, 'CursorLocation', adUseClient ) x=OleCallMethod(Conn, 'Open', ConnectionString) If OleStatus() Then Conn=' retval=OleStatus() End return Update: STATE=OleGetProperty(conn, 'State') if state=adStateOpen else Set_Status(1, 'Connection is closed or busy') retval=-1 return end tablename =P1 record=P2 identityColName =P3 trace_flag=P4 if identityColName else identityColName=counter' Could look this up using ADO Schema query end /* * Create a New row, get the value of the identity key */ sql=INSERT INTO " : tableName : " DEFAULT VALUES SELECT @@IDENTITY 'mycounter'" rsCreate=OleCallMethod(Conn, 'Execute', sql) If OleStatus() Then rsCreate=' Goto ErrorHandler End rs=OleGetProperty( rsCreate, 'NextRecordset') If OleStatus() Then rs=' Goto ErrorHandler End fields =OleGetProperty( rs, 'Fields') this_field=OleGetProperty( Fields, 'Item', 'mycounter') counter=OleGetProperty( This_Field, 'Value') x=OleCallMethod(rs, 'Close') x=OleCallMethod(rsCreate, 'Close') rs=' rsCreate=' If counter Else Goto ErrorHandler End /* * Perform the update */ sql=SELECT * FROM ": tablename : " WHERE ": identityColName : "= : counter cmd=OleCreateInstance("ADODB.Command") OlePutProperty(cmd, 'ActiveConnection', conn ) OlePutProperty(cmd, 'CommandType', adCmdText ) OlePutProperty(cmd, 'CommandText', Sql) rs=OleCreateInstance("ADODB.Recordset") OlePutProperty(rs, 'LockType', adLockOptimistic ) OlePutProperty(rs, 'CursorLocation', adUseClient ) OlePutProperty(rs, 'CursorType', adopenkeyset ) OlePutProperty(rs, 'CacheSize', 10 ) x=OleCallMethod(rs, 'Open', cmd ) If OleStatus() Then rs=' Goto ErrorHandler End cmd=' fields=OleGetProperty(rs, 'Fields') colcount=OleGetProperty(fields, 'Count') x=OleCallMethod(rs, 'MoveFirst') If OleGetProperty(rs, 'EOF') Else * Skip key column * remember oi is 1 based, ADO is 0 based For j=1 to colcount this_val=record * ASSUME I can ignore blanks, since I just made the row * Don't need to change the id column, we got it in the SELECT If Len(this_val) Then this_field=OleGetproperty(fields, 'Item', j-1) * Special Handling? this_name=OleGetproperty(this_field, 'Name') this_Type=OleGetproperty(this_field, 'Type') this_len =OleGetproperty(this_field, 'DefinedSize') if this_name _nec identityColName then Begin case case this_type=adDate Or this_type=adDBDate If Num(this_val) then work=Oconv(this_Val, 'D4-') this_Val=Field(work,'-',3) : Field(work,'-',2,2) end case this_type=adDBTime If Num(this_val) then work=Oconv(this_Val, 'MTHS') transfer work To this_Val end end case this_val=this_val1,this_len OlePutProperty(this_field, 'Value', this_val) end end Until OleStatus() next * Write if OleStatus() else x=OleCallMethod(rs, 'Update') x=OleStatus() end End x=OleCallMethod(rs, 'Close') rs=' fields=' this_field=' /* * Echo it back? */ if trace_flag then sql=SELECT * FROM chargeback WHERE counter= : counter rs=OleCallMethod(Conn, 'Execute', sql) fields=OleGetProperty(rs, 'Fields') x=OleStatus() colcount=OleGetProperty(fields, 'Count') x=OleStatus() * Headings this_row=' for j=0 to colcount-1 this_field=OleGetProperty(fields, 'Item', j) this_name=OleGetProperty(this_field, 'Name') If j ] 1 Then this_row := @vm this_row:= this_name Next rowNr=1 list=this_row Convert @vm To tab$ In this_row Call Send_Dyn(this_row) * Detail Loop done=OleGetProperty(rs, 'EOF') Until done this_row=' for j=1 to colcount this_field=OleGetproperty(fields, 'Item', j) value=OleGetproperty(this_field, 'Value') If j]1 Then this_row := @vm this_row:= value next Convert @vm to tab$ in this_row call send_dyn(this_row) x=OleCallMethod(rs, 'MoveNext') Repeat x=OleCallMethod(rs, 'Close') x=OleCallMethod(conn, 'Close') rs=' End return counter DisConnect: x=oleCallMethod(conn, 'Close') conn=' Return ErrorHandler: If Assigned(err ) Else err=An Error has Occured' Set_Status(true$, err) x=OleCallMethod(rs, 'Close') x=OleCallMethod(rsCreate, 'Close') x=oleCallMethod(conn, 'Close') cmd=' rs=' rscreate=' fields=' this_field=' conn=' Return '' * * The Equate ** compile insert Microsoft_Ado_Equates ——————————————————————– Microsoft ADO © 1996 Microsoft Corporation. All Rights Reserved. ADO equates include file for VBScript ——————————————————————– —- CursorTypeEnum Values —- equ adOpenForwardOnly to 0 equ adOpenKeyset to 1 equ adOpenDynamic to 2 equ adOpenStatic to 3 —- CursorOptionEnum Values —- equ adHoldRecords to 0x00000100 equ adMovePrevious to 0x00000200 equ adAddNew to 0x01000400 equ adDelete to 0x01000800 equ adUpdate to 0x01008000 equ adBookmark to 0x00002000 equ adApproxPosition to 0x00004000 equ adUpdateBatch to 0x00010000 equ adResync to 0x00020000 equ adNotify to 0x00040000 —- LockTypeEnum Values —- equ adLockReadOnly to 1 equ adLockPessimistic to 2 equ adLockOptimistic to 3 equ adLockBatchOptimistic to 4 —- ExecuteOptionEnum Values —- equ adRunAsync to 0x00000010 —- ObjectStateEnum Values —- equ adStateClosed to 0x00000000 equ adStateOpen to 0x00000001 equ adStateConnecting to 0x00000002 equ adStateExecuting to 0x00000004 —- CursorLocationEnum Values —- equ adUseServer to 2 equ adUseClient to 3 —- DataTypeEnum Values —- equ adEmpty to 0 equ adTinyInt to 16 equ adSmallInt to 2 equ adInteger to 3 equ adBigInt to 20 equ adUnsignedTinyInt to 17 equ adUnsignedSmallInt to 18 equ adUnsignedInt to 19 equ adUnsignedBigInt to 21 equ adSingle to 4 equ adDouble to 5 equ adCurrency to 6 equ adDecimal to 14 equ adNumeric to 131 equ adBoolean to 11 equ adError to 10 equ adUserDefined to 132 equ adVariant to 12 equ adIDispatch to 9 equ adIUnknown to 13 equ adGUID to 72 equ adDate to 7 equ adDBDate to 133 equ adDBTime to 134 equ adDBTimeStamp to 135 equ adBSTR to 8 equ adChar to 129 equ adVarChar to 200 equ adLongVarChar to 201 equ adWChar to 130 equ adVarWChar to 202 equ adLongVarWChar to 203 equ adBinary to 128 equ adVarBinary to 204 equ adLongVarBinary to 205 —- FieldAttributeEnum Values —- equ adFldMayDefer to 0x00000002 equ adFldUpdatable to 0x00000004 equ adFldUnknownUpdatable to 0x00000008 equ adFldFixed to 0x00000010 equ adFldIsNullable to 0x00000020 equ adFldMayBeNull to 0x00000040 equ adFldLong to 0x00000080 equ adFldRowID to 0x00000100 equ adFldRowVersion to 0x00000200 equ adFldCacheDeferred to 0x00001000 —- EditModeEnum Values —- equ adEditNone to 0x0000 equ adEditInProgress to 0x0001 equ adEditAdd to 0x0002 equ adEditDelete to 0x0004 —- RecordStatusEnum Values —- equ adRecOK to 0x0000000 equ adRecNew to 0x0000001 equ adRecModified to 0x0000002 equ adRecDeleted to 0x0000004 equ adRecUnmodified to 0x0000008 equ adRecInvalid to 0x0000010 equ adRecMultipleChanges to 0x0000040 equ adRecPendingChanges to 0x0000080 equ adRecCanceled to 0x0000100 equ adRecCantRelease to 0x0000400 equ adRecConcurrencyViolation to 0x0000800 equ adRecIntegrityViolation to 0x0001000 equ adRecMaxChangesExceeded to 0x0002000 equ adRecObjectOpen to 0x0004000 equ adRecOutOfMemory to 0x0008000 equ adRecPermissionDenied to 0x0010000 equ adRecSchemaViolation to 0x0020000 equ adRecDBDeleted to 0x0040000 —- GetRowsOptionEnum Values —- equ adGetRowsRest to -1 —- PositionEnum Values —- equ adPosUnknown to -1 equ adPosBOF to -2 equ adPosEOF to -3 —- enum Values —- equ adBookmarkCurrent to 0 equ adBookmarkFirst to 1 equ adBookmarkLast to 2 —- MarshalOptionsEnum Values —- equ adMarshalAll to 0 equ adMarshalModifiedOnly to 1 —- AffectEnum Values —- equ adAffectCurrent to 1 equ adAffectGroup to 2 equ adAffectAll to 3 —- FilterGroupEnum Values —- equ adFilterNone to 0 equ adFilterPendingRecords to 1 equ adFilterAffectedRecords to 2 equ adFilterFetchedRecords to 3 equ adFilterPredicate to 4 —- SearchDirection Values —- equ adSearchForward to 1 equ adSearchBackward to -1 —- ConnectPromptEnum Values —- equ adPromptAlways to 1 equ adPromptComplete to 2 equ adPromptCompleteRequired to 3 equ adPromptNever to 4 —- ConnectModeEnum Values —- equ adModeUnknown to 0 equ adModeRead to 1 equ adModeWrite to 2 equ adModeReadWrite to 3 equ adModeShareDenyRead to 4 equ adModeShareDenyWrite to 8 equ adModeShareExclusive to 0xc equ adModeShareDenyNone to 0x10 —- IsolationLevelEnum Values —- equ adXactUnspecified to 0xffffffff equ adXactChaos to 0x00000010 equ adXactReadUncommitted to 0x00000100 equ adXactBrowse to 0x00000100 equ adXactCursorStability to 0x00001000 equ adXactReadCommitted to 0x00001000 equ adXactRepeatableRead to 0x00010000 equ adXactSerializable to 0x00100000 equ adXactIsolated to 0x00100000 —- XactAttributeEnum Values —- equ adXactCommitRetaining to 0x00020000 equ adXactAbortRetaining to 0x00040000 —- PropertyAttributesEnum Values —- equ adPropNotSupported to 0x0000 equ adPropRequired to 0x0001 equ adPropOptional to 0x0002 equ adPropRead to 0x0200 equ adPropWrite to 0x0400 —- ErrorValueEnum Values —- equ adErrInvalidArgument to 0xbb9 equ adErrNoCurrentRecord to 0xbcd equ adErrIllegalOperation to 0xc93 equ adErrInTransaction to 0xcae equ adErrFeatureNotAvailable to 0xcb3 equ adErrItemNotFound to 0xcc1 equ adErrObjectInCollection to 0xd27 equ adErrObjectNotSet to 0xd5c equ adErrDataConversion to 0xd5d equ adErrObjectClosed to 0xe78 equ adErrObjectOpen to 0xe79 equ adErrProviderNotFound to 0xe7a equ adErrBoundToCommand to 0xe7b equ adErrInvalidParamInfo to 0xe7c equ adErrInvalidConnection to 0xe7d equ adErrStillExecuting to 0xe7f equ adErrStillConnecting to 0xe81 —- ParameterAttributesEnum Values —- equ adParamSigned to 0x0010 equ adParamNullable to 0x0040 equ adParamLong to 0x0080 —- ParameterDirectionEnum Values —- equ adParamUnknown to 0x0000 equ adParamInput to 0x0001 equ adParamOutput to 0x0002 equ adParamInputOutput to 0x0003 equ adParamReturnValue to 0x0004 —- CommandTypeEnum Values —- equ adCmdUnknown to 0x0008 equ adCmdText to 0x0001 equ adCmdTable to 0x0002 equ adCmdStoredProc to 0x0004 —- SchemaEnum Values —- equ adSchemaProviderSpecific to -1 equ adSchemaAsserts to 0 equ adSchemaCatalogs to 1 equ adSchemaCharacterSets to 2 equ adSchemaCollations to 3 equ adSchemaColumns to 4 equ adSchemaCheckequraints to 5 equ adSchemaequraintColumnUsage to 6 equ adSchemaequraintTableUsage to 7 equ adSchemaKeyColumnUsage to 8 equ adSchemaReferentialContraints to 9 equ adSchemaTableequraints to 10 equ adSchemaColumnsDomainUsage to 11 equ adSchemaIndexes to 12 equ adSchemaColumnPrivileges to 13 equ adSchemaTablePrivileges to 14 equ adSchemaUsagePrivileges to 15 equ adSchemaProcedures to 16 equ adSchemaSchemata to 17 equ adSchemaSQLLanguages to 18 equ adSchemaStatistics to 19 equ adSchemaTables to 20 equ adSchemaTranslations to 21 equ adSchemaProviderTypes to 22 equ adSchemaViews to 23 equ adSchemaViewColumnUsage to 24 equ adSchemaViewTableUsage to 25 equ adSchemaProcedureParameters to 26 equ adSchemaForeignKeys to 27 equ adSchemaPrimaryKeys to 28 equ adSchemaProcedureColumns to 29 * End of Equate * </QUOTE> —- === At 18 DEC 2008 10:59PM Barry Stevens wrote: === <QUOTE>My insert is not working. Ignoring the init values for the sql line; should I expect the following code to work..i.e. the method of executing the insert. subroutine myob_test_ado_write(Void) $insert Microsoft_Ado_Equates declare function OleCreateInstance common /ado_identity_common/conn ConnectionString=" ConnectionString:=DSN=Myob FManager;" ConnectionString:=ACCESS_TYPE=READ_WRITE;" conn=OleCreateInstance("ADODB.Connection") OlePutProperty(conn, 'MODE', adModeShareDenyNone) OlePutProperty(conn, 'CursorLocation', adUseClient ) x=OleCallMethod(Conn, 'Open', ConnectionString) If OleStatus() Then Conn=' retval=OleStatus() return End /* * Create a New Invoice */ ColNames=" sql=INSERT INTO IMPORT_SERVICE_SALES " Sql:=ColNames:" " Sql:=VALUES " Values=( )" Sql:=Values rsCreate=OleCallMethod(Conn, 'Execute', sql) x=OleStatus() If x Then debug rsCreate=' Goto ErrorHandler End x=oleCallMethod(conn, 'Close') conn=' return ErrorHandler: Return </QUOTE> —- === At 19 DEC 2008 12:45AM Bob Carten wrote: === <QUOTE> Barry, The generic format has parens around column names too. INSERT INTO table_name (column1, column2, column3,…) VALUES (value1, value2, value3,…) Leave numbers bare and strings surrounded by single quotes. MsAcess may want dates surrounded by sharp signs too, e.g. '#01/01/2009#' See http://www.w3schools.com/SQL/sql_insert.asp To debug I would save a copy of the sql statement you created, then execute it in the client workspace or from Excel, see if it runs correctly. </QUOTE> —- === At 19 DEC 2008 09:33PM Barry Stevens wrote: === <QUOTE>Great, thanks for your tips. </QUOTE> View this thread on the Works forum...