|
Visual Basic (VB and VBA) |
|
Copyright 1999-2001 Christopher Greaves. All rights reserved. Home Page and email to [email protected] |
| If in doubt, record a macro and inspect the entrails! |
Please read the DISCLAIMER.
Here is an INDEX to all the procedures.
You will probably need one copy of my GLOBAL DECLARATIONS.
'Public Function lngGetTable(strArray, strPath As String, strFile As String, strTable As String) As Long
'' Procedure : lngGetTable
'' Description: Returns a string array from an Acess97 database table.
'' Copyright: Chris Greaves
'' Inputs: Database path, file and table name , all as strings.
'' Returns: The number of rows in the array.
'' Assumes: None.
'' Side Effects: None.
'' Tested: By the calls shown below.
' Dim wrk As Workspace
' Set wrk = wrkCreateWorkspace("", "admin", "")
' If boolFileExists(strPath & Application.PathSeparator & strFile) Then
' Dim dbs As Database
' Set dbs = dbsOpenDatabase(wrk, strPath, strFile) ' given path and file
' Dim rst As Recordset
' Set rst = rstOpenRecordset(dbs, "SELECT * from " & strTable) ' given table
' Dim lngRows As Long
' rst.MoveLast: rst.MoveFirst
' lngRows = rst.RecordCount ' this many records/rows.
' strArray = rst.GetRows(lngRows)
' lngGetTable = UBound(strArray, 2)
' Call CloseRecordset(rst)
' Call CloseDatabase(dbs)
' Call wrkCloseWorkspace(wrk)
' Else
' Call ERL("lngGetTable ", intcErrorFatal, "Can't find this file " & strPath & Application.PathSeparator & strFile)
' End If
''Sub TESTlngGetTable()
'' Dim strar
'' Dim lngRows As Long
'' lngRows = lngGetTable(strar, strTemplatePath(), "utilities.mdb", "utilities")
'' MsgBox lngRows
'' MsgBox strar(2, 3)
''End Sub
'End Function
'
Public Function lngGetTable(strArray, strPath As String, strFile As String, strTable As String) As Long
' Procedure : lngGetTable
' Description: Returns a string array from an Acess97 database table.
' Copyright: Chris Greaves
' Inputs: Database path, file and table name , all as strings.
' Returns: The number of rows in the array.
' Assumes: None.
' Side Effects: None.
' Tested: By the calls shown below.
Dim wrk As Workspace
Set wrk = wrkCreateWorkspace("", "admin", "")
Dim strFileName As String
strFileName = strPath & strFile & strcExtentSeparator & strDBExtent
If boolFileExists(strFileName) Then
Dim dbs As Database
Set dbs = dbsOpenDatabase(wrk, strPath, strFile) ' given path and file
Dim rst As Recordset
Set rst = rstOpenRecordset(dbs, "SELECT * from " & strTable) ' given table
If rst Is Nothing Then
Call ERL("lngGetTable ", intcErrorSevere, "Can't find this table " & strTable)
Else
Dim lngRows As Long
rst.MoveLast: rst.MoveFirst
lngRows = rst.RecordCount ' this many records/rows.
strArray = rst.GetRows(lngRows)
lngGetTable = UBound(strArray, 2)
Call CloseRecordset(rst)
End If
Call CloseDatabase(dbs)
Call wrkCloseWorkspace(wrk)
Else
Call ERL("lngGetTable ", intcErrorSevere, "Can't find this file " & strFileName)
End If
'Sub TESTlngGetTable()
' Dim strar
' Dim lngRows As Long
' lngRows = lngGetTable(strar, strTemplatePath(), "utilities.mdb", "utilities")
' MsgBox lngRows
' MsgBox strar(2, 3)
'End Sub
End Function
| We all knew nothing when we started … |
|
Home Page and Contact Information Send email to [email protected]. This page was last updated Thursday, November 15, 2001 |