Appendix D: ODBC Cursors in VBA

The following example makes an ODBC connection to your specified datasource and returns the first five rows.

Some lines of code below exceed the printed page. Such lines use an underscore as a line continuation character.

'Selected ODBC Core API's Definitions -- 32 bit versions
Declare Function SQLAllocConnect Lib "odbc32.dll" (ByVal_
 hEnvironmentv&, phConnect&) As Integer
Declare Function SQLAllocEnv Lib "odbc32.dll" (phEnvironmentv&)_
 As Integer
Declare Function SQLAllocStmt Lib "odbc32.dll" (ByVal hConnect&,_
 phstmt&) As Integer
Declare Function SQLConnect Lib "odbc32.dll" (ByVal hConnect&,_
 ByVal szDSN$, ByVal cbDSN%, ByVal szUID$, ByVal cbUID%, ByVal_
 szAuthStr$, ByVal cbAuthStr%) As Integer
Declare Function SQLSetStmtOption Lib "odbc32.dll" (ByVal_
 hstmt&, ByVal fOption%, ByVal vParam&) As Integer
Declare Function SQLSetCursorName Lib "odbc32.dll" (ByVal_
 hstmt&, ByVal szCursor$, ByVal cbCursor%) As Integer
Declare Function SQLExecDirect Lib "odbc32.dll" (ByVal hstmt&,_
 ByVal szSqlStr$, ByVal cbSqlStr&) As Integer
Declare Function SQLNumResultCols Lib "odbc32.dll" (ByVal_
 hstmt&, pccol%) As Integer
Declare Function SQLExtendedFetch Lib "odbc32.dll" (ByVal_
 hstmt&, ByVal fFetchType%, ByVal irow&, pcrow&, rgfRowStatus%)_
 As Integer
Declare Function SQLSetPos Lib "odbc32.dll" (ByVal hstmt&, ByVal_
 irow%, ByVal fOption%, ByVal fLock%) As Integer
Declare Function SQLDisconnect Lib "odbc32.dll" (ByVal_
 hConnect&) As Integer
Declare Function SQLFreeConnect Lib "odbc32.dll" (ByVal_
 hConnect&) As Integer
Declare Function SQLFreeEnv Lib "odbc32.dll" (ByVal_
 hEnvironmentv&) As Integer
Declare Function SQLGetData Lib "odbc32.dll" (ByVal hstmt&,_
 ByVal icol%, ByVal fCType%, ByVal rgbValue As String, ByVal_
 cbValueMax&, pcbValue&) As Integer
Global Const SQL_ERROR As Long = -1
Global Const SQL_INVALID_HANDLE As Long = -2
Global Const SQL_NO_DATA_FOUND As Long = 100
Global Const SQL_SUCCESS As Long = 0
Global Const SQL_SUCCESS_WITH_INFO As Long = 1
Global Const SQL_CONCUR_READ_ONLY As Long = 1
Global Const SQL_CONCUR_LOCK As Long = 2
Global Const SQL_CONCUR_ROWVER As Long = 3
Global Const SQL_CONCUR_VALUES As Long = 4
Global Const SQL_CURSOR_FORWARD_ONLY As Long = 0
Global Const SQL_CURSOR_KEYSET_DRIVEN As Long = 1
Global Const SQL_CURSOR_TYPE As Long = 6
Global Const SQL_CONCURRENCY As Long = 7
Global Const SQL_ROWSET_SIZE As Long = 9
Global Const SQL_NTS As Long = -3
'Global Const SQL_FETCH_NEXT As Long = 1
Global Const SQL_FETCH_FIRST As Long = 2
Global Const SQL_POSITION As Long = 0
Global Const SQL_LOCK_NO_CHANGE As Long = 0
Global Const SQL_CHAR As Long = 1

Function callODBCcursor()
    Dim Result As Integer           'Return value.
    Dim hEnvironment As Long        'Environment handle.
    Dim hConnect As Long            'Connection handle.
    Dim hstmt As Long               'Statement handle.
    Dim errorlocation As String
    Dim RowSetSize As Long
    Dim strSQL As String
    Dim ColCount As Integer
    Dim strThisRecord As String * 256
    Dim outlen As Long
    Dim strData As String
    Dim strDataFinal As String
    Dim RowCount As Integer
    Dim Cols As Integer
    Dim RowNum As Long
    Dim RowsGot As Long
    Dim RowStat As Integer

    On Error GoTo callODBCcursor_err
      

    ' Get an environment and connection handle
    Result = SQLAllocEnv(hEnvironment)    'Allocate environment handle
' allocate connection handle
    Result = SQLAllocConnect(ByVal hEnvironment, hConnect) 
    ' Set up the connection string
    Dim strdsn As String, strUID As String, strPWD As String
    strdsn = InputBox("Enter the name of your_
              datasource.""Datasource Name?")
        If strdsn = "" Then
            errorlocation = "DatasourceName"

            GoTo callODBCcursor_err
        End If
    strUID = "sa"
    strPWD = ""
    'Establish the connection
    Result = SQLConnect(hConnect, strdsn, Len(strdsn), strUID,_
                    Len(strUID), strPWD, Len(strPWD))
If Result = SQL_ERROR Then    'SQL_ERROR is +1
            errorlocation = "SQLConnect"
            GoTo callODBCcursor_err
        End If

    'Allocate a statement handle.
    Result = SQLAllocStmt(hConnect, hstmt)
        If Result = SQL_ERROR Then
errorlocation = "SQLAllocStmt"
            GoTo callODBCcursor_err
        End If
    'Specifies "optimistic concurrency control, comparing row versions"
    Result = SQLSetStmtOption(hstmt, SQL_CONCURRENCY,_
                     SQL_CONCUR_ROWVER)
        If Result = SQL_ERROR Then
            errorlocation = "SQLSetStmtOption, Concurrency"
            GoTo callODBCcursor_err
        End If
    'Specifies a keyset driven cursor
    Result = SQLSetStmtOption(hstmt, SQL_CURSOR_TYPE,_
                   SQL_CURSOR_KEYSET_DRIVEN)
        If Result = SQL_ERROR Then
            errorlocation = "SQLSetStmtOption Cursor Type"
            GoTo callODBCcursor_err
        End If
    'Specifies the number of rows that are returned with the keyset
    RowSetSize = 5
    Result = SQLSetStmtOption(hstmt, SQL_ROWSET_SIZE,_
                   RowSetSize)
        If Result = SQL_ERROR Then
            errorlocation = "SQLSetStmtOption Rowset Size"
            GoTo callODBCcursor_err
        End If
    Result = SQLSetCursorName(hstmt, "C1", SQL_NTS)
        If Result = SQL_ERROR Then
            errorlocation = "SQLSetCursorName"
            GoTo callODBCcursor_err
        End If

    'The SQL String that defines the data being returned by the cursor
    strSQL = "Select title_id, title from titles"
    'Submit the SQL Statement
    Result = SQLExecDirect(hstmt, strSQL, Len(strSQL))
    'How many columns came back?
    Result = SQLNumResultCols(hstmt, ColCount)
    
RowCount = 1

    Result = SQLExtendedFetch(hstmt, SQL_FETCH_FIRST,_
                   RowNum, RowsGot, RowStat)
    
    'Loop through each row "fetched" by the cursor
    For RowCount = 1 To RowSetSize
        Result = SQLSetPos(hstmt, RowCount, SQL_POSITION,_
                       SQL_LOCK_NO_CHANGE)

            'Loop through each column
            strData = ""
            For Cols = 1 To ColCount
                Result = SQLGetData(hstmt, Cols, SQL_CHAR,_
                                strThisRecord, 256, outlen)
                strData = strData & Left(strThisRecord, outlen)
      'Add_ spaces for formatting

If Cols < ColCount Then strData = strData & "    " 
            Next Cols
        strDataFinal = strDataFinal & strData & Chr$(10) & Chr$(13)
    Next RowCount
    

    'Display final output
    Beep
    MsgBox strDataFinal

    'Disconnect and free the connection and environment handles
    Result = SQLDisconnect(hConnect)
    Result = SQLFreeConnect(hConnect)
    Result = SQLFreeEnv(hEnvironment)

Exit Function

callODBCcursor_err:
    MsgBox "Error in section " & errorlocation & "."
    MsgBox "Error " & Err & ": " & Err.Description
    Result = SQLDisconnect(hConnect)
    Result = SQLFreeConnect(hConnect)
    Result = SQLFreeEnv(hEnvironment)
End Function