• Welcome to Powerbasic Museum 2020-B.
 

News:

Forum in repository mode. No new members allowed.

Main Menu

ADO/ADOX Examples

Started by José Roca, August 20, 2011, 10:47:41 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

José Roca

#15


This example uses the Filter property to limit the number of visible records to a particular city.


' ########################################################################################
' Microsoft Windows
' File: ADOEX_Filter.bas
' Contents: ADO example
' This example uses the Filter property to limit the number of visible records to a
' particular city.
' Compilers: PBWIN 10+, PBCC 6+
' Headers: Windows API headers 2.03+
' Copyright (c) 2011 José Roca. Freeware. Use at your own risk.
' Portions Copyright (c) Microsoft Corporation. All Rights Reserved.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

' CSED_PBCC ' Use PBCC compiler
#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "ADO.INC"

' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN

   LOCAL pConnection AS ADOConnection
   LOCAL pRecordset AS ADORecordset
   LOCAL ConStr AS WSTRING
   LOCAL SqlStr AS WSTRING
   LOCAL vRes AS VARIANT

   ' // Create a Connection object
   pConnection = NEWCOM "ADODB.Connection"
   IF ISNOTHING(pConnection) THEN EXIT FUNCTION

   ' // Create a Recordset object
   pRecordset = NEWCOM "ADODB.Recordset"
   IF ISNOTHING(pRecordset) THEN EXIT FUNCTION

   TRY
      ' // Connection String - Change it if needed
      ConStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=biblio.mdb"
      ' // Open the connection
      pConnection.Open ConStr
      ' // Open the recordset
      SqlStr = "SELECT * FROM Publishers"
      pRecordset.Open SqlStr, pConnection, %adOpenStatic, %adLockOptimistic, %adCmdText
      ' // Set the Filter property
      STDOUT STR$(pRecordset.RecordCount)
      pRecordset.Filter = "City = 'New York'"
      STDOUT STR$(pRecordset.RecordCount)
      DO
         ' // While not at the end of the recordset...
         IF pRecordset.EOF THEN EXIT DO
         ' // Get the contents of the "City" and "Name" columns
         vRes = pRecordset.Collect("City")
         PRINT VARIANT$$(vRes) " ";
         vRes = pRecordset.Collect("Name")
         PRINT VARIANT$$(vRes)
         ' // Fetch the next row
         pRecordset.MoveNext
      LOOP
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      ' // Close the recordset
      IF pRecordset.State = %adStateOpen THEN pRecordset.Close
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

   WAITKEY$

END FUNCTION
' ========================================================================================


José Roca

#16


The following example demonstrates the use of the Find method.


' ########################################################################################
' Microsoft Windows
' File: ADOEX_Find.bas
' Contents: ADO example
' Demonstrates the use of the Find method.
' Compilers: PBWIN 10+, PBCC 6+
' Headers: Windows API headers 2.03+
' Copyright (c) 2011 José Roca. Freeware. Use at your own risk.
' Portions Copyright (c) Microsoft Corporation. All Rights Reserved.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

' CSED_PBCC ' Use PBCC compiler
#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "ADO.INC"

' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN

   LOCAL pConnection AS ADOConnection
   LOCAL pRecordset AS ADORecordset
   LOCAL ConStr AS WSTRING
   LOCAL SqlStr AS WSTRING
   LOCAL vRes AS VARIANT

   ' // Create a Connection object
   pConnection = NEWCOM "ADODB.Connection"
   IF ISNOTHING(pConnection) THEN EXIT FUNCTION

   ' // Create a Recordset object
   pRecordset = NEWCOM "ADODB.Recordset"
   IF ISNOTHING(pRecordset) THEN EXIT FUNCTION

   TRY
      ' // Connection String - Change it if needed
      ConStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=biblio.mdb"
      ' // Open the connection
      pConnection.Open ConStr
      ' // Open the recordset
      SqlStr = "SELECT * FROM Publishers ORDER By PubID"
      pRecordset.Open SqlStr, pConnection, %adOpenKeyset, %adLockOptimistic, %adCmdText
      pRecordset.Find "PubID = #70#", 0, %adSearchForward
      vRes = pRecordset.Collect("PubID")
      PRINT VARIANT#(vRes) " ";
      vRes = pRecordset.Collect("Name")
      PRINT VARIANT$$(vRes)
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      ' // Close the recordset
      IF pRecordset.State = %adStateOpen THEN pRecordset.Close
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

   WAITKEY$

END FUNCTION
' ========================================================================================


José Roca

This example shows how to extract the bitmap photos in the Microsoft Access 97 Nwind.mdb database and save them to a file. In order to accomplish this task, the Access and OLE headers must be stripped from the field.

Because the definition of OLE object storage is not documented, the code below searches the object's OLE header for characters consistent with the start of the graphic. This method may not work in all circumstances.

Note  Adaptation of the code posted in the following Microsoft Knowledge Base article: http://support.microsoft.com/kb/q175261/


' ########################################################################################
' Microsoft Windows
' File: ADOEX_GetBitmap.bas
' Contents: ADO example
' How to Retrieve Bitmap from Access
' Compilers: PBWIN 10+, PBCC 6+
' Headers: Windows API headers 2.03+
' Copyright (c) 2011 José Roca. Freeware. Use at your own risk.
' Portions Copyright (c) Microsoft Corporation. All Rights Reserved.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

' ########################################################################################
' How to Retrieve Bitmap from Access
' This example shows how to extract the bitmap photos in the Microsoft Access 97 Nwind.mdb
' database and save them to a file. In order to accomplish this task, an the Access and
' OLE headers must be stripped from the field.
' Because the definition of OLE object storage is not documented, the code below searches
' the object's OLE header for characters consistent with the start of the graphic. This
' method may not work in all circumstances.
' Note: Adaptation of the code posted in the following Microsoft Knowledge Base article:
' http://support.microsoft.com/kb/q175261/
' ########################################################################################

' CSED_PBCC ' Use PBCC compiler
#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "ADO.INC"

TYPE OBJECTHEADER
  Signature    AS INTEGER
  HeaderSize   AS INTEGER
  ObjectType   AS LONG
  NameLen      AS INTEGER
  ClassLen     AS INTEGER
  NameOffset   AS INTEGER
  ClassOffset  AS INTEGER
  ObjectWidth  AS INTEGER
  ObjectHeight AS INTEGER
  OleInfo      AS ASCIIZ * 256
END TYPE

' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN

   LOCAL pConnection AS ADOConnection
   LOCAL pRecordset AS ADORecordset
   LOCAL pFields AS ADOFields
   LOCAL pField AS ADOField
   LOCAL ConStr AS WSTRING
   LOCAL SqlStr AS WSTRING
   LOCAL nSize AS LONG
   LOCAL vRes AS VARIANT
   LOCAL ObjectOffset AS LONG
   LOCAL BitmapHeaderOffset AS INTEGER
   LOCAL BitmapOffset AS LONG
   LOCAL Buffer AS STRING
   LOCAL i AS LONG
   DIM   Arr(0) AS BYTE
   DIM   ArrBmp(0) AS BYTE
   DIM   ObjHeader AS OBJECTHEADER

   ' // Create a Connection object
   pConnection = NEWCOM "ADODB.Connection"
   IF ISNOTHING(pConnection) THEN EXIT FUNCTION

   ' // Create a Recordset object
   pRecordset = NEWCOM "ADODB.Recordset"
   IF ISNOTHING(pRecordset) THEN EXIT FUNCTION

   TRY
      ' // Connection String - Change it if needed
      ConStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=nwind.mdb"
      ' // Open the connection
      pConnection.Open ConStr
      ' // Open the recordset
      SqlStr = "SELECT * FROM Employees ORDER BY EmployeeID"
      pRecordset.Open SqlStr, pConnection, %adOpenKeyset, %adLockOptimistic, %adCmdText
      ' // Find the record
      pRecordset.Find "LastName = 'Davolio'", 0, 1
      ' // Get a reference to the Fields collection
      pFields = pRecordset.Fields
      ' // Get a reference to the Field object
      pField = pFields.Item("Photo")
      ' // Retrieve the actual size of the field
      nSize = pField.ActualSize
      ' // Get the content of the field
      vRes = pField.GetChunk(nSize)
      ' // Release the Field object
      pField = NOTHING
      ' // Release the Fields collection
      pFields = NOTHING
      ' // Store the content in a byte array
      Arr() = vRes
      ' // Empty the variant
      vRes = EMPTY
      ' // Copy information into a variable of the OBJECTHEADER user defined type
'      CopyMemory VARPTR(ObjHeader), VARPTR(Arr(0)), SIZEOF(OBJECTHEADER)
      MEMORY COPY VARPTR(Arr(0)), VARPTR(ObjHeader), SIZEOF(OBJECTHEADER)
      ' // Determine where the Access Header ends
      ObjectOffset = ObjHeader.HeaderSize + 1
      ' // Grab enough bytes after the OLE header to get the bitmap header
      FOR i = ObjectOffset TO ObjectOffset + 512
         IF UBOUND(Arr) => i THEN
            Buffer = Buffer & CHR$(Arr(i))
         END IF
      NEXT i
      ' // Make sure the class of the object is a Paint Brush object
      IF MID$(Buffer, 12, 6) = "PBrush" THEN
         BitmapHeaderOffset = INSTR(Buffer, "BM")
         IF BitmapHeaderOffset THEN
            ' // Calculate the beginning of the bitmap
            BitmapOffset = ObjectOffset + BitmapHeaderOffset - 1
            ' // Move the bitmap into its own array
            REDIM ArrBmp(UBOUND(Arr) - BitmapOffset)
            CopyMemory VARPTR(ArrBmp(0)), VARPTR(Arr(BitmapOffset)), UBOUND(Arr) - BitmapOffset + 1
            ' // Save the bitmap to a file. Change path as needed.
            OPEN "Photo.bmp" FOR BINARY AS #1
            PUT #1, 1, ArrBmp()
            CLOSE #1
            STDOUT "File saved"
         END IF
      END IF
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      ' // Close the recordset
      IF pRecordset.State = %adStateOpen THEN pRecordset.Close
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

   WAITKEY$

END FUNCTION
' ========================================================================================


José Roca


' ########################################################################################
' Microsoft Windows
' File: ADOEX_GetErrorInfo.bas
' Contents: ADO example
' The following example tests the GetErrorInfo wrapper function to display rich error
' information. It contains an intentional error in the select clause of the query:
' SELEC instead of SELECT.
' Compilers: PBWIN 10+, PBCC 6+
' Headers: Windows API headers 2.03+
' Copyright (c) 2011 José Roca. Freeware. Use at your own risk.
' Portions Copyright (c) Microsoft Corporation. All Rights Reserved.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

' CSED_PBCC ' Use PBCC compiler
#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "ADO.INC"

' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN

   LOCAL pConnection AS ADOConnection
   LOCAL pRecordset AS ADORecordset
   LOCAL ConStr AS WSTRING
   LOCAL SqlStr AS WSTRING
   LOCAL vRes AS VARIANT

   ' // Create a Connection object
   pConnection = NEWCOM "ADODB.Connection"
   IF ISNOTHING(pConnection) THEN EXIT FUNCTION

   ' // Create a Recordset object
   pRecordset = NEWCOM "ADODB.Recordset"
   IF ISNOTHING(pRecordset) THEN EXIT FUNCTION

   TRY
      ' // Connection String - Change it if needed
      ConStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=biblio.mdb"
      ' // Open the connection
      pConnection.Open ConStr
      ' // Open the recordset
      ' // Trigger an error by writing incorrectly the name of SELECT
      SqlStr = "SELEC TOP 20 * FROM Authors ORDER BY Author"
      pRecordset.Open SqlStr, pConnection, %adOpenKeyset, %adLockOptimistic, %adCmdText
      DO
         ' // While not at the end of the recordset...
         IF pRecordset.EOF THEN EXIT DO
         ' // Get the content of the "Author" column
         vRes = pRecordset.Collect("Author")
         PRINT VARIANT$(vRes)
         ' // Fetch the next row
         pRecordset.MoveNext
      LOOP
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      ' // Close the recordset
      IF pRecordset.State = %adStateOpen THEN pRecordset.Close
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

   WAITKEY$

END FUNCTION
' ========================================================================================


José Roca


' ########################################################################################
' Microsoft Windows
' File: ADOEX_GetOrdinalColumnNumbers.bas
' Contents: ADO example
' Retrieves the ordinal column numbers of a table.
' Compilers: PBWIN 10+, PBCC 6+
' Headers: Windows API headers 2.03+
' Copyright (c) 2011 José Roca. Freeware. Use at your own risk.
' Portions Copyright (c) Microsoft Corporation. All Rights Reserved.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "ADO.INC"
#INCLUDE ONCE "OLEDB.INC"

' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN

   LOCAL hr AS LONG                         ' // HRESULT code
   LOCAL pConnection AS ADOConnection       ' // Connection object
   LOCAL pRecordset AS ADORecordset         ' // Recordset object
   LOCAL ConStr AS WSTRING                  ' // Connection string
   LOCAL SqlStr AS WSTRING                  ' // Query string
   LOCAL pRC AS ADORecordsetConstruction    ' // RecordsetConstruction object
   LOCAL pRowset AS IRowset                 ' // IRowset interface
   LOCAL pCI AS IColumnsInfo                ' // IColumnsInfo interface
   LOCAL prgInfo AS DBCOLUMNINFO PTR        ' // Pointer variable to access the DBCOLUMNINFO array of structures
   LOCAL pStringsBuffer AS WSTRINGZ PTR     ' // Address of the strings
   LOCAL ulNumColumns AS DWORD              ' // Number of columns
   LOCAL i AS LONG                          ' // Loop counter
   LOCAL iOrdinal AS DWORD                  ' // Ordinal

   ' // Create a Connection object
   pConnection = NEWCOM "ADODB.Connection"
   IF ISNOTHING(pConnection) THEN EXIT FUNCTION

   ' // Create a Recordset object
   pRecordset = NEWCOM "ADODB.Recordset"
   IF ISNOTHING(pRecordset) THEN EXIT FUNCTION

   TRY
      ' // Connection String - Change it if needed
      ConStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=biblio.mdb"
      ' // Open the connection
      pConnection.Open ConStr
      ' // Set the cursor location
      pRecordset.CursorLocation = %adUseClient
      ' // Open the recordset
      SqlStr = "Publishers"
      pRecordset.Open SqlStr, pConnection, %adOpenStatic, %adLockOptimistic, %adCmdTable
      ' // Get a reference to the ADORecordsetConstruction object
      pRC = pRecordset
      IF ISNOTHING(pRC) THEN EXIT TRY
      ' // Get a reference to the Rowset interface
      pRowset = pRc.Rowset
      ' // Release the ADORecordsetConstruction object (no longer needed)
      pRC = NOTHING
      ' // Terminate if pRowset is false
      IF ISNOTHING(pRowset) THEN EXIT TRY
      ' // Get a reference to the IColumnsInfo interface
      pCI = pRowset
      IF ISNOTHING(pCI) THEN EXIT TRY
      ' // Retrieve the information about the columns
      hr = pCI.GetColumnInfo(ulNumColumns, prgInfo, pStringsBuffer)
      IF hr = %S_OK THEN
         ' // Show the number of columns (including the one reserved for bookmarks, if any)
         ? "Columns = " & STR$(ulNumColumns)
         ' // If the recordset supports bookmarks, column 0 is reserved for them,
         ' // so change the start index from 0 to 1
         FOR i = 0 TO ulNumColumns - 1
            IF @prgInfo[i].pwszName THEN
               ' // Retrieve the ordinal number
               iOrdinal = @prgInfo[i].iOrdinal
               ' // Show the ordinal number and the name of the column
               ? "Ordinal =" & STR$(iOrdinal) & " | Name = " & @prgInfo[i].@pwszName
               ' // Free the memory allocated by the server for the name
               CoTaskMemFree @prgInfo[i].pwszName
            END IF
         NEXT
         ' // Free the memory allocated by the server for the array of DBCOLUMNINFO structures
         CoTaskMemFree prgInfo
         ' // Free the memory allocated by the server for the strings block
         CoTaskMemFree pStringsBuffer
      END IF

      ' // Release the IColumnsInfo interface
      pCI = NOTHING
      ' // Release the IRowset interface
      pRowset = NOTHING

   CATCH
      ' // Display error information
      ? AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      ' // Close the recordset
      IF pRecordset.State = %adStateOpen THEN pRecordset.Close
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

   #IF %DEF(%PB_CC32)
      WAITKEY$
   #ENDIF

END FUNCTION
' ========================================================================================


José Roca

#20


The following example demonstrates the use of the GetRows method.


' ########################################################################################
' Microsoft Windows
' File: ADOEX_GetRows.bas
' Contents: ADO example
' Demonstrates the use of the GetRows method.
' Compilers: PBWIN 10+, PBCC 6+
' Headers: Windows API headers 2.03+
' Copyright (c) 2011 José Roca. Freeware. Use at your own risk.
' Portions Copyright (c) Microsoft Corporation. All Rights Reserved.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

' CSED_PBCC ' Use PBCC compiler
#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "ADO.INC"
#INCLUDE ONCE "AfxVarToStr.INC"

' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN

   LOCAL pConnection AS ADOConnection
   LOCAL pRecordset AS ADORecordset
   LOCAL ConStr AS WSTRING
   LOCAL SqlStr AS WSTRING

   ' // Create a Connection object
   pConnection = NEWCOM "ADODB.Connection"
   IF ISNOTHING(pConnection) THEN EXIT FUNCTION

   ' // Create a Recordset object
   pRecordset = NEWCOM "ADODB.Recordset"
   IF ISNOTHING(pRecordset) THEN EXIT FUNCTION

   TRY
      ' // Connection String - Change it if needed
      ConStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=biblio.mdb"
      ' // Open the connection
      pConnection.Open ConStr
      ' // Open the recordset
      SqlStr = "SELECT TOP 20 * FROM Publishers ORDER BY Name"
      pRecordset.Open SqlStr, pConnection, %adOpenKeyset, %adLockOptimistic, %adCmdText
      ' // Get all the rows of the recordset in a two-dimensional safe array
      LOCAL vRows AS VARIANT
      vRows = pRecordset.GetRows(-1)
      ' // Copy the contents in a Variant array
      DIM vRowsArray(0 TO 0) AS VARIANT
      vRowsArray() = vRows
      ' // Calculate the lower and upper bounds of the array
      LOCAL il AS LONG, iu AS LONG
      LOCAL  jl AS LONG, ju AS LONG
      il = LBOUND(vRowsArray, 1)
      iu = UBOUND(vRowsArray, 1)
      jl = LBOUND(vRowsArray, 2)
      ju = UBOUND(vRowsArray, 2)
      ' // Print the contents of the array
      LOCAL i AS LONG, j AS LONG
      FOR j = jl TO ju
         FOR i = il TO iu
            STDOUT AfxVarToStr(vRowsArray(i, j))
         NEXT
         PRINT
      NEXT
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      ' // Close the recordset
      IF pRecordset.State = %adStateOpen THEN pRecordset.Close
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

   WAITKEY$

END FUNCTION
' ========================================================================================


José Roca

#21


Assume you are debugging a data access problem and want a quick, simple way of printing the current contents of a small recordset. The GetString method returns the recordset as a string that you can print or save to a text file.


' ########################################################################################
' Microsoft Windows
' File: ADOEX_GetString.bas
' Contents: ADO example
' Assume you are debugging a data access problem and want a quick, simple way of printing
' the current contents of a small recordset. The GetString method returns the recordset as
' a string that you can print or save to a text file.
' Compilers: PBWIN 10+, PBCC 6+
' Headers: Windows API headers 2.03+
' Copyright (c) 2011 José Roca. Freeware. Use at your own risk.
' Portions Copyright (c) Microsoft Corporation. All Rights Reserved.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

' CSED_PBCC ' Use PBCC compiler
#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "ADO.INC"

' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN

   LOCAL pConnection AS ADOConnection
   LOCAL pRecordset AS ADORecordset
   LOCAL ConStr AS WSTRING
   LOCAL SqlStr AS WSTRING
   LOCAL bstrText AS WSTRING

   ' // Create a Connection object
   pConnection = NEWCOM "ADODB.Connection"
   IF ISNOTHING(pConnection) THEN EXIT FUNCTION

   ' // Create a Recordset object
   pRecordset = NEWCOM "ADODB.Recordset"
   IF ISNOTHING(pRecordset) THEN EXIT FUNCTION

   TRY
      ' // Connection String - Change it if needed
      ConStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=biblio.mdb"
      ' // Open the connection
      pConnection.Open ConStr
      ' // Open the recordset
      SqlStr = "SELECT * FROM Publishers"
      pRecordset.Open SqlStr, pConnection, %adOpenStatic, %adLockOptimistic, %adCmdText
      ' // Get the recordset as an string
      bstrText = pRecordset.GetString(%adClipString, %adReadAll)
      STDOUT bstrText
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      ' // Close the recordset
      IF pRecordset.State = %adStateOpen THEN pRecordset.Close
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

   WAITKEY$

END FUNCTION
' ========================================================================================


José Roca

How do I get the AutoNumber (or Identity) for a newly inserted record?

The AutoNumber field should always be available when a server-side cursor is used.

However, if a client-side cursor location is used, then the AutoNumber field is only returned immediately when an Access 2000 database is used with OLE DB Provider for Jet 4.0 driver (or with the Jet 4.0 ODBC driver).

http://support.microsoft.com/kb/q244136/


' ########################################################################################
' Microsoft Windows
' File: ADOEX_Identity.bas
' Contents: ADO example
' Compilers: PBWIN 10+, PBCC 6+
' Headers: Windows API headers 2.03+
' Copyright (c) 2011 José Roca. Freeware. Use at your own risk.
' Portions Copyright (c) Microsoft Corporation. All Rights Reserved.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

' ########################################################################################
' How do I get the AutoNumber (or Identity) for a newly inserted record?
' The AutoNumber field should always be available when a server-side cursor is used.
' However, if a client-side cursor location is used, then the AutoNumber field is only
' returned immediately when an Access 2000 database is used with OLE DB Provider for
' Jet 4.0 driver (or with the Jet 4.0 ODBC driver).
' http://support.microsoft.com/kb/q244136/
' ########################################################################################

' CSED_PBCC ' Use PBCC compiler
#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "ADO.INC"

' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN

   LOCAL pConnection AS ADOConnection
   LOCAL pRecordset AS ADORecordset
   LOCAL pProperties AS ADOProperties
   LOCAL pProperty AS ADOProperty
   LOCAL ConStr AS WSTRING
   LOCAL SqlStr AS WSTRING
   LOCAL vRes AS VARIANT
   DIM   vFieldList(2) AS VARIANT
   DIM   vValues(2) AS VARIANT

   ' // Create a Connection object
   pConnection = NEWCOM "ADODB.Connection"
   IF ISNOTHING(pConnection) THEN EXIT FUNCTION

   ' // Create a Command object
   pRecordset = NEWCOM "ADODB.Recordset"
   IF ISNOTHING(pRecordset) THEN EXIT FUNCTION

   TRY
      ' // Connection String - Change it if needed
      ConStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=biblio.mdb"
      ' // Open the connection
      pConnection.Open ConStr
      ' // Set the cursor location
      pRecordset.CursorLocation = %adUseClient
      ' // Get a reference to the Properties collection
      pProperties = pRecordset.Properties
      pProperty = pProperties.Item("Update Resync")
      pProperty.Value = %adResyncAutoIncrement
      ' // Open the recordset
      SqlStr = "SELECT * FROM Contacts2"
      pRecordset.Open SqlStr, pConnection, %adOpenStatic, %adLockBatchOptimistic, %adCmdText
      ' // Add a record
      vFieldList(0) = "FirstName"
      vFieldList(1) = "LastName"
      vFieldList(2) = "Phone"
      vValues(0) = "John"
      vValues(1) = "Smith"
      vValues(2) = "(111)111-1111"
      LOCAL v1 AS VARIANT, v2 AS VARIANT
      v1 = vFieldList()
      v2 = vValues()
      pRecordset.AddNew v1, v2
      pRecordset.Update   ' // Update local Recordset (since %adLockBatchOptimistic)
      ' // Add another record
      vValues(0) = "Jack"
      vValues(1) = "Sparrow"
      vValues(2) = "(222)222-2222"
      v2 = vValues()
      pRecordset.AddNew v1, v2
      pRecordset.Update   ' // Update local Recordset (since %adLockBatchOptimistic)
      ' // Update the Access database (4.0 format)
      pRecordset.MarshalOptions = %adMarshalModifiedOnly
      pRecordset.UpdateBatch %adAffectAll
      ' // New autonumber for the 2nd AddNew
      vRes = pRecordset.Collect("ContactId")
      PRINT VARIANT#(vRes)
      ' // New autonumber for the 1st AddNew
      pRecordset.MovePrevious
      vRes = pRecordset.Collect("ContactId")
      PRINT VARIANT#(vRes)
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      ' // Close the recordset
      IF pRecordset.State = %adStateOpen THEN pRecordset.Close
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

   WAITKEY$

END FUNCTION


José Roca

#23


The following example demonstrates the use of the Index property.


' ########################################################################################
' Microsoft Windows
' File: ADOEX_Index.bas
' Contents: ADO example
' Demonstrates the use of the Index property and the Seek method.
' Compilers: PBWIN 10+, PBCC 6+
' Headers: Windows API headers 2.03+
' Copyright (c) 2011 José Roca. Freeware. Use at your own risk.
' Portions Copyright (c) Microsoft Corporation. All Rights Reserved.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

' CSED_PBCC ' Use PBCC compiler
#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "ADO.INC"

' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN

   LOCAL pConnection AS ADOConnection
   LOCAL pRecordset AS ADORecordset
   LOCAL ConStr AS WSTRING
   LOCAL SqlStr AS WSTRING
   LOCAL vRes AS VARIANT

   ' // Create a Connection object
   pConnection = NEWCOM "ADODB.Connection"
   IF ISNOTHING(pConnection) THEN EXIT FUNCTION

   ' // Create a Recordset object
   pRecordset = NEWCOM "ADODB.Recordset"
   IF ISNOTHING(pRecordset) THEN EXIT FUNCTION

   TRY
      ' // Connection String - Change it if needed
      ConStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=biblio.mdb"
      ' // Open the connection
      pConnection.Open ConStr
      ' // Set the cursor location
      pRecordset.CursorLocation = %adUseServer
      ' // Open the recordset
      SqlStr = "Publishers"
      pRecordset.Open SqlStr, pConnection, %adOpenKeyset, %adLockOptimistic, %adCmdTableDirect
      ' // Set the index
      pRecordset.Index = "PrimaryKey"
      ' // See the record 70
      pRecordset.Seek 70, 1

      DO
         ' // While not at the end of the recordset...
         IF pRecordset.EOF THEN EXIT DO
         ' // Get the content of the "Author" column
         vRes = pRecordset.Collect("PubID")
         PRINT VARIANT$$(vRes)" ";
         vRes = pRecordset.Collect("Name")
         PRINT VARIANT$$(vRes)" ";
         vRes = pRecordset.Collect("Company Name")
         PRINT VARIANT$$(vRes)" "
         ' // Fetch the next row
         pRecordset.MoveNext
      LOOP
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      ' // Close the recordset
      IF pRecordset.State = %adStateOpen THEN pRecordset.Close
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

   WAITKEY$

END FUNCTION
' ========================================================================================


José Roca

#24


The following example illustrates the use of the Name property.


' ########################################################################################
' Microsoft Windows
' File: ADOEX_Name.bas
' Contents: ADO example
' Demonstrates the use of the Attributes and Name properties.
' Compilers: PBWIN 10+, PBCC 6+
' Headers: Windows API headers 2.03+
' Copyright (c) 2011 José Roca. Freeware. Use at your own risk.
' Portions Copyright (c) Microsoft Corporation. All Rights Reserved.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

' CSED_PBCC ' Use PBCC compiler
#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "ADO.INC"

' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN

   LOCAL pConnection AS ADOConnection
   LOCAL pRecordset AS ADORecordset
   LOCAL pProperties AS ADOProperties
   LOCAL pProperty AS ADOProperty
   LOCAL pFields AS ADOFields
   LOCAL pField AS ADOField
   LOCAL ConStr AS WSTRING
   LOCAL SqlStr AS WSTRING
   LOCAL nCount AS LONG
   LOCAL lAttr AS LONG
   LOCAL i AS LONG

   ' // Create a Connection object
   pConnection = NEWCOM "ADODB.Connection"
   IF ISNOTHING(pConnection) THEN EXIT FUNCTION

   ' // Create a Recordset object
   pRecordset = NEWCOM "ADODB.Recordset"
   IF ISNOTHING(pRecordset) THEN EXIT FUNCTION

   TRY
      ' // Connection String - Change it if needed
      ConStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=biblio.mdb"
      ' // Open the connection
      pConnection.Open ConStr
      ' // Open the recordset
      SqlStr = "SELECT * FROM Publishers"
      pRecordset.Open SqlStr, pConnection, %adOpenStatic, %adLockOptimistic, %adCmdText
      ' // Parse the Properties collection
      pProperties = pRecordset.Properties
      nCount = pProperties.Count
      FOR i = 0 TO nCount - 1
         pProperty = pProperties.Item(i)
         PRINT "Property name: " & pProperty.Name " - ";
         PRINT "Attributes: " & STR$(pProperty.Attributes)
         pProperty = NOTHING
      NEXT
      pProperties = NOTHING
      ' // Parse the Fields collection
      pFields = pRecordset.Fields
      nCount = pFields.Count
      IF nCount THEN
         PRINT
         PRINT "Nullable fields:"
         PRINT "================"
         PRINT
      END IF
      FOR i = 0 TO nCount - 1
         pField = pFields.Item(i)
         ' // Get the attributes of the field
         lAttr = pField.Attributes
         ' // Display fields that are nullable
         IF (lAttr AND %adFldIsNullable) = %adFldIsNullable THEN
            PRINT "Field name: " & pField.Name
         END IF
         pField = NOTHING
      NEXT
      pFields = NOTHING
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      ' // Close the recordset
      IF pRecordset.State = %adStateOpen THEN pRecordset.Close
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

   WAITKEY$

END FUNCTION
' ========================================================================================


José Roca

#25


The following example opens a connection with the biblio.mdb database, creates a recordset and parses the result.


' ########################################################################################
' Microsoft Windows
' File: ADOEX_Open.bas
' Contents: ADO example
' Opens a connection, creates a recordset and parses the result.
' Compilers: PBWIN 10+, PBCC 6+
' Headers: Windows API headers 2.03+
' Copyright (c) 2011 José Roca. Freeware. Use at your own risk.
' Portions Copyright (c) Microsoft Corporation. All Rights Reserved.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

' CSED_PBCC ' Use PBCC compiler
#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "ADO.INC"

' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN

   LOCAL pConnection AS ADOConnection
   LOCAL pRecordset AS ADORecordset
   LOCAL ConStr AS WSTRING
   LOCAL SqlStr AS WSTRING
   LOCAL vRes AS VARIANT

   ' // Create a Connection object
   pConnection = NEWCOM "ADODB.Connection"
   IF ISNOTHING(pConnection) THEN EXIT FUNCTION

   ' // Create a Recordset object
   pRecordset = NEWCOM "ADODB.Recordset"
   IF ISNOTHING(pRecordset) THEN EXIT FUNCTION

   TRY
      ' // Connection String - Change it if needed
      ConStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=biblio.mdb"
      ' // Open the connection
      pConnection.Open ConStr
      ' // Open the recordset
      SqlStr = "SELECT TOP 20 * FROM Authors ORDER BY Author"
      pRecordset.Open SqlStr, pConnection, %adOpenKeyset, %adLockOptimistic, %adCmdText
      DO
         ' // While not at the end of the recordset...
         IF pRecordset.EOF THEN EXIT DO
         ' // Get the content of the "Author" column
         vRes = pRecordset.Collect("Author")
         PRINT VARIANT$$(vRes)
         ' // Fetch the next row
         pRecordset.MoveNext
      LOOP
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      ' // Close the recordset
      IF pRecordset.State = %adStateOpen THEN pRecordset.Close
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

   WAITKEY$

END FUNCTION
' ========================================================================================


José Roca

#26


The following example illustrates the use of the AbsolutePage property. The cursor location must be set to adUseClient.


' ########################################################################################
' Microsoft Windows
' File: ADOEX_PageCount.bas
' Contents: ADO example
' Demonstrates the use of the AbsolutePage, PageCount and PageSize properties.
' The cursor location must be set to %adUseClient.
' Compilers: PBWIN 10+, PBCC 6+
' Headers: Windows API headers 2.03+
' Copyright (c) 2011 José Roca. Freeware. Use at your own risk.
' Portions Copyright (c) Microsoft Corporation. All Rights Reserved.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

' CSED_PBCC ' Use PBCC compiler
#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "ADO.INC"

' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN

   LOCAL pConnection AS ADOConnection
   LOCAL pRecordset AS ADORecordset
   LOCAL ConStr AS WSTRING
   LOCAL SqlStr AS WSTRING
   LOCAL nPageCount AS LONG
   LOCAL nPageSize AS LONG
   LOCAL i AS LONG
   LOCAL x AS LONG
   LOCAL vRes AS VARIANT

   ' // Create a Connection object
   pConnection = NEWCOM "ADODB.Connection"
   IF ISNOTHING(pConnection) THEN EXIT FUNCTION

   ' // Create a Recordset object
   pRecordset = NEWCOM "ADODB.Recordset"
   IF ISNOTHING(pRecordset) THEN EXIT FUNCTION

   TRY
      ' // Connection String - Change it if needed
      ConStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=biblio.mdb"
      ' // Open the connection
      pConnection.Open ConStr
      ' // Use client cursor to enable AbsolutePosition property
      pRecordset.CursorLocation = %adUseClient
      ' // Open the recordset
      SqlStr = "SELECT * FROM Publishers"
      pRecordset.Open SqlStr, pConnection, %adOpenStatic, %adLockOptimistic, %adCmdText
      ' // Display five records at a time
      pRecordset.PageSize = 5
      ' // Retrieve the number of pages
      nPageCount = pRecordset.PageCount
      ' // Parses the recordset
      FOR i = 1 TO nPageCount
         ' // Set the cursor at the beginning of the page
         pRecordset.AbsolutePage = i
         ' // Retrieve the number of records of the page
         nPageSize = pRecordset.PageSize
         FOR x = 1 TO nPageSize
            ' // Get the content of the "Name" column
            vRes = pRecordset.Collect("Name")
            STDOUT VARIANT$$(vRes)
            ' // Fetch the next row
            pRecordset.MoveNext
            IF pRecordset.EOF THEN EXIT FOR
         NEXT
         WAITKEY$
      NEXT
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      ' // Close the recordset
      IF pRecordset.State = %adStateOpen THEN pRecordset.Close
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

   WAITKEY$

END FUNCTION
' ========================================================================================


José Roca

#27


The following example illustrates the use of the PageSize property. The cursor location must be set to adUseClient.


' ########################################################################################
' Microsoft Windows
' File: ADOEX_PageSize.bas
' Contents: ADO example
' Demonstrates the use of the AbsolutePage, PageCount and PageSize properties
' The cursor location must be set to %adUseClient.
' Compilers: PBWIN 10+, PBCC 6+
' Headers: Windows API headers 2.03+
' Copyright (c) 2011 José Roca. Freeware. Use at your own risk.
' Portions Copyright (c) Microsoft Corporation. All Rights Reserved.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

' CSED_PBCC ' Use PBCC compiler
#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "ADO.INC"

' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN

   LOCAL pConnection AS ADOConnection
   LOCAL pRecordset AS ADORecordset
   LOCAL ConStr AS WSTRING
   LOCAL SqlStr AS WSTRING
   LOCAL nPageCount AS LONG
   LOCAL nPageSize AS LONG
   LOCAL i AS LONG
   LOCAL x AS LONG
   LOCAL vRes AS VARIANT

   ' // Create a Connection object
   pConnection = NEWCOM "ADODB.Connection"
   IF ISNOTHING(pConnection) THEN EXIT FUNCTION

   ' // Create a Recordset object
   pRecordset = NEWCOM "ADODB.Recordset"
   IF ISNOTHING(pRecordset) THEN EXIT FUNCTION

   TRY
      ' // Connection String - Change it if needed
      ConStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=biblio.mdb"
      ' // Open the connection
      pConnection.Open ConStr
      ' // Use client cursor to enable AbsolutePosition property
      pRecordset.CursorLocation = %adUseClient
      ' // Open the recordset
      SqlStr = "SELECT * FROM Publishers"
      pRecordset.Open SqlStr, pConnection, %adOpenStatic, %adLockOptimistic, %adCmdText
      ' // Display five records at a time
      pRecordset.PageSize = 5
      ' // Retrieve the number of pages
      nPageCount = pRecordset.PageCount
      ' // Pars the recordset
      FOR i = 1 TO nPageCount
         ' // Set the cursor at the beginning of the page
         pRecordset.AbsolutePage = i
         ' // Retrieve the number of records of the page
         nPageSize = pRecordset.PageSize
         FOR x = 1 TO nPageSize
            ' // Get the content of the "Name" column
            vRes = pRecordset.Collect("Name")
            STDOUT VARIANT$$(vRes)
            ' // Fetch the next row
            pRecordset.MoveNext
            IF pRecordset.EOF THEN EXIT FOR
         NEXT
         WAITKEY$
      NEXT
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      ' // Close the recordset
      IF pRecordset.State = %adStateOpen THEN pRecordset.Close
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

   WAITKEY$

END FUNCTION
' ========================================================================================


José Roca

#28
The following example demonstrates how to read an Excel sheet using ADO.

There are two problems: 1) The name of the sheets is localized, so instead of SqlStr = "SELECT * FROM [Hoja1$]" you will have to use the appropriate name for your version, e.g. SqlStr = "SELECT * FROM [Sheet1$]" for the English version. 2) The Excel sheet maybe has not column names.

To solve these problems, the second example uses the OpenSchema method to retrieve the names of the sheets as if they were tables and uses ordinals instead of column names.


' ########################################################################################
' Microsoft Windows
' File: ADOEX_ReadExcelSheet.bas
' Contents: ADO example
' Demonstrates how to read an Excel sheet using ADO.
' Compilers: PBWIN 10+, PBCC 6+
' Headers: Windows API headers 2.03+
' Copyright (c) 2011 José Roca. Freeware. Use at your own risk.
' Portions Copyright (c) Microsoft Corporation. All Rights Reserved.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

' CSED_PBCC ' Use PBCC compiler
#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "ADO.INC"

' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN

   LOCAL pConnection AS ADOConnection
   LOCAL pRecordset AS ADORecordset
   LOCAL ConStr AS WSTRING
   LOCAL SqlStr AS WSTRING
   LOCAL vRes AS VARIANT

   ' // Creates a Connection object
   pConnection = NEWCOM "ADODB.Connection"
   IF ISNOTHING(pConnection) THEN EXIT FUNCTION

   ' // Create a Recordset object
   pRecordset = NEWCOM "ADODB.Recordset"
   IF ISNOTHING(pRecordset) THEN EXIT FUNCTION

   TRY
      ' // Connection String - Change it if needed
      ConStr = "Provider=MSDASQL;Driver={Microsoft Excel Driver (*.xls)};DBQ=test.xls;ReadOnly=False"
      ' // Open the connection
      pConnection.Open ConStr
      ' // Set the cursor location
      pRecordset.CursorLocation = %adUseClient
      ' // Open the recordset
      ' // Instead of [Hoja1$] you will need to use the appropiate
      ' // name if you aren't using an Spanish version of Excel,
      ' // e.g. [Sheet1$] for the English version.
      SqlStr = "SELECT * FROM [Hoja1$]"
      pRecordset.Open SqlStr, pConnection, %adOpenStatic, %adLockOptimistic, %adCmdText
      DO
         ' // While not at the end of the recordset...
         IF pRecordset.EOF THEN EXIT DO
         vRes = pRecordset.Collect("Column 1")
         PRINT VARIANT$$(vRes)
         vRes = pRecordset.Collect("Column 2")
         PRINT VARIANT$$(vRes)
         ' // Fetch the next row
         pRecordset.MoveNext
      LOOP
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      ' // Close the recordset
      IF pRecordset.State = %adStateOpen THEN pRecordset.Close
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

   WAITKEY$

END FUNCTION
' ========================================================================================


José Roca


' ########################################################################################
' Microsoft Windows
' File: ADOEX_ReadExcelSheet2.bas
' Contents: ADO example
' Compilers: PBWIN 10+, PBCC 6+
' Headers: Windows API headers 2.03+
' Copyright (c) 2011 José Roca. Freeware. Use at your own risk.
' Portions Copyright (c) Microsoft Corporation. All Rights Reserved.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

' ########################################################################################
' Demonstrates how to open an excel sheet and parse it as if it where a recordset.
' To solve the problem that the name of the sheet is localized ("Sheet", in English,
' "Hoja", in Spanish, etc.), first we use the OpenSchema method to retrieve the names of
' the excel sheets; then we open a recordset for each sheet, retrieve the number of columns
' and read them.
' Assumes that the first row contains the names of the columns and that all the rows have
' the same number of columns.
' ########################################################################################

' CSED_PBCC ' Use PBCC compiler
#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "ADO.INC"

' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN

   LOCAL hr AS DWORD
   LOCAL pConnection AS ADOConnection
   LOCAL pRecordset AS ADORecordset
   LOCAL pFields AS ADOFields
   LOCAL ConStr AS WSTRING
   LOCAL SqlStr AS WSTRING
   LOCAL vRes AS VARIANT
   LOCAL c AS LONG
   LOCAL i AS LONG
   LOCAL x AS LONG
   DIM   TablesArray() AS STRING

   ' // Create a Connection object
   pConnection = NEWCOM "ADODB.Connection"
   IF ISNOTHING(pConnection) THEN EXIT FUNCTION

   TRY
      ' // Connection String - Change it if needed
      ConStr = "Provider=MSDASQL;Driver={Microsoft Excel Driver (*.xls)};DBQ=test3.xls;ReadOnly=False"
      ' // Open the connection
      pConnection.Open ConStr
      ' // Open the schema
      pRecordset = pConnection.OpenSchema(%adSchemaTables)
      pRecordset.MoveFirst
      DO
         ' // While not at the end of the recordset...
         IF pRecordset.EOF THEN EXIT DO
         vRes = pRecordset.Collect("TABLE_NAME")
         PRINT "Table Name = " VARIANT$$(vRes)
         REDIM PRESERVE TablesArray(UBOUND(TablesArray) + 1)
         TablesArray(UBOUND(TablesArray)) = VARIANT$$(vRes)
         ' // Fetch the next row
         pRecordset.MoveNext
      LOOP
      ' // Close the recordset
      pRecordset.Close
      PRINT "-----------------------------------"
      ' // Open a recordset for each sheet
      IF UBOUND(TablesArray) > -1 THEN
         FOR i = LBOUND(TablesArray) TO UBOUND(TablesArray)
            SqlStr = "SELECT * FROM [" & TablesArray(i) & "]"
            pRecordset.Open SqlStr, pConnection, %adOpenStatic, -1, -1
            ' // Get a reference to the Fields collection
            pFields = pRecordset.Fields
            ' // Number of fields (columns)
            c = pFields.Count
            ' // Release the Fields collection
            pFields = NOTHING
            DO
               ' // While not at the end of the recordset...
               IF pRecordset.EOF THEN EXIT DO
               ' // Get the content of the columns
               FOR x = 0 TO c - 1
                  vRes = EMPTY
                  vRes = pRecordset.Collect(x)
                  IF VARIANTVT(vRes) = %VT_BSTR THEN
                     PRINT VARIANT$$(vRes)
                  ELSE
                     PRINT STR$(VARIANT#(vRes))
                  END IF
               NEXT
               ' // Fetch the next row
               pRecordset.MoveNext
            LOOP
            ' // Close the recordset
            pRecordset.Close
            PRINT "-----------------------------------"
         NEXT
      END IF
   CATCH
      ' // Display error information
      STDOUT AdoGetErrorInfo(pConnection, OBJRESULT)
   FINALLY
      IF ISOBJECT(pRecordset) THEN
         ' // Close the recordset
         IF pRecordset.State = %adStateOpen THEN pRecordset.Close
      END IF
      ' // Close the connection
      IF pConnection.State = %adStateOpen THEN pConnection.Close
   END TRY

   WAITKEY$

END FUNCTION
' ========================================================================================