| Вопрос: Как вывести имеющиеся таблицы? | Добавлено: 23.04.07 19:05 |
Автор вопроса:  Stas
|
| Ответы | Всего ответов: 16 |
|
Номер ответа: 16 Автор ответа:  HACKER Разработчик Offline Client Вопросов: 236 Ответов: 8362 |
Профиль | | #16 | Добавлено: 26.04.07 02:36 |
|
Public Function GetTableArray(byval DataBasePath As String, byval Password As String, _
ReturnArray() As String) As Long '+ 'Возвращает массив ReturnArray с именами таблиц. 'В случае успеха принимает значение 0, иначе номер ошибки Set dbObj = New ADODB.Connection Dim rsSchema As ADODB.Recordset Dim dbConnectionString As String On Error GoTo e dbConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0  ata Source=" & DataBasePath$ & ";" & _
IIf(Trim(Password) <> "", "Jet OLEDB:Database Password=" & Trim$(Password$) & ";", "" 
ReDim ReturnArray(0) dbObj.Open dbConnectionString If dbObj.state = adStateOpen Then Set rsSchema = dbObj.OpenSchema(adSchemaTables, Array(Empty, Empty, Empty, "TABLE" )
If Not rsSchema Is Nothing Then Do While Not rsSchema.EOF If UCase(Left(rsSchema!Table_name, 4)) <> "MSYS" Then If UCase(Left(rsSchema!Table_name, 11)) <> "SWITCHBOARD" Then NewTableName = rsSchema!Table_name ReturnArray(UBound(ReturnArray)) = NewTableName ReDim Preserve ReturnArray(UBound(ReturnArray) + 1) End If End If rsSchema.MoveNext Loop End If End If 'ReDim Preserve ReturnArray(UBound(ReturnArray) - 1) GetTableArray = 0 rsSchema.Close Set rsSchema = Nothing Set dbObj = Nothing Exit Function e: GetTableArray = Err.Number Debug.Print Err.Description escriptionLastError = Err.Description
On Error GoTo 0: On Error Resume Next Set rsSchema = Nothing Set dbObj = Nothing End Function |
||