Imprimir página | Cerrar ventana

Listado de tablas en Base Externa

Impreso de: Foro de Access y VBA
Categoría: Access y VBA
Nombre del foro: Tus Funciones Favoritas & Aportaciones & Artí­culos
Descripción del foro: Para publicar código interesante, aportaciones y artículos
URL: http://www.mvp-access.com/foro/forum_posts.asp?TID=77265
Fecha de impresión: 23/Febrero/2020 a las 09:48


Tema: Listado de tablas en Base Externa
Publicado por: buho
Asunto: Listado de tablas en Base Externa
Fecha de publicación: 10/Agosto/2013 a las 08:15
Un sencillismo procedimiento que nos lista las tablas de una BD externa a la que corr el codigo. Puede emplearse, por ejemplo, como un «documentador» muy elemental (Ampliable, por supuesto) o mismamente, con unas minimas adaptaciones, para saber si una table existe en una BD externa.

Va cósigo, uno con DAO y otra con ADO :

Sub ListaTablasMdb(StrRutaDataBase)
    Dim Base As Object ' DAO.Database
    Dim Tablas As Object ' DAO.TableDef
    Set Base = OpenDatabase(StrRutaDataBase)
    For Each Tablas In Base.TableDefs
            MsgBox Tablas.Name
    Next
    Base.Close
    Set Base = Nothing
End Sub
 
 
Sub Probando()
 ListaTablasMdb CurrentProject.Path & "\otrabase.mdb"
End Sub


Con ADO

Sub ExtraeTablas(StrRutaBase)
    Dim conexion As New ADODB.Connection
    Dim Catalogo As New ADOX.Catalog
    Dim ObjetoTabla As ADOX.Table
    conexion.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                  "data source=" & StrRutaBase & ";"
    Catalogo.ActiveConnection = conexion
    For Each ObjetoTabla In Catalogo.Tables
        If ObjetoTabla.Type <> "VIEW" And ObjetoTabla.Type <> _
           "ACCESS TABLE" And ObjetoTabla.Type <> "SYSTEM TABLE" Then
            MsgBox ObjetoTabla.Name
        End If
    Next
    conexion.Close
    Set conexion = Nothing
    Set Catalogo = Nothing
End Sub


Este otro es un poco mas completo (Por Emilio Sancha)
 
Public Sub DocumentarTablas()
Dim Tabla As TableDef, _
    Campo As DAO.Field, _
    rst As DAO.Recordset, _
    rstET As DAO.Recordset, _
    strTabla As String, _
    strSQL As String
   
' creo una tabla en que guardar el resultado
strTabla = "EstructuraTablas"
' si ya existiera la borro
ExisteTabla strTabla, True
strSQL = "CREATE TABLE " & strTabla
strSQL = strSQL & " (Tabla TEXT(255) CONSTRAINT PrimaryKey PRIMARY KEY,"
strSQL = strSQL & " Vinculada TEXT(1),"
strSQL = strSQL & " Campo TEXT(255),"
strSQL = strSQL & " Tipo TEXT(25),"
strSQL = strSQL & " Tamaño Byte,"
strSQL = strSQL & " Requerido TEXT(1),"
strSQL = strSQL & " ValorPorDefecto TEXT(25),"
strSQL = strSQL & " ReglaDeValidacion TEXT(255),"
strSQL = strSQL & " TextodeValidacion TEXT(255))"
CurrentDb.Execute strSQL
' la abro
Set rstET = CurrentDb.OpenRecordset(strTabla, dbOpenDynaset)
' recorro los table defs de la base de datos
For Each Tabla In CurrentDb.TableDefs
   ' inserto los datos de los campos de todas las tablas excepto las
   ' tablas de sistema y la que contendrá los resultados
   If Not Tabla.name Like "MSys*" And Not Tabla.name = strTabla Then
      Set rst = CurrentDb.OpenRecordset(CStr(Tabla.name), dbOpenDynaset)
      For Each Campo In rst.Fields
         rstET.AddNew
         rstET!Tabla = Tabla.name
         rstET!Vinculada = IIf(Nz(Tabla.Connect, "") <> "", "S", "N")
         rstET!Campo = Campo.name
         rstET!Tipo = TipoCampo(Campo.Type)
         rstET!Requerido = IIf(Campo.Required, "S", "N")
         rstET!ValorPorDefecto = Nz(Campo.DefaultValue, "")
         rstET!RegladeValidacion = Nz(Campo.ValidationRule, "")
         rstET!TextodeValidacion = Campo.ValidationText
         If Campo.Type = dbText Then rstET!Tamaño = Campo.size
         rstET.Update
      Next Campo
      rst.Close
   End If
Next  ' Tabla
CierraRecordsetDAO rst
CierraRecordsetDAO rstET
End Sub        ' DocumentarTablas

Public Function TipoCampo(bytTipo As Byte) As String
Select Case bytTipo
   Case 5, 6, 9, 11
      TipoCampo = bytTipo
   Case 1
      TipoCampo = "Sí/No"
   Case 2
      TipoCampo = "Byte"
   Case 3
      TipoCampo = "Entero"
   Case 4
      TipoCampo = "Entero Largo"
   Case 7
      TipoCampo = "Doble"
   Case 8
      TipoCampo = "Fecha"
   Case 10
      TipoCampo = "Texto"
   Case 12
      TipoCampo = "Hipervinculo"
End Select
End Function         ' TipoCampo

'*******************************************************************************
'* ExisteTabla
'* comprueba si existe la tabla pasada como parametro, devolviendo Verdadero / Falso
'* Argumentos:
'* uso: ExisteTabla(strTabla, True) elimina tabla en caso de que exista
'* ESH 21/04/99 08:57
'*******************************************************************************
Public Function ExisteTabla(strTabla As String, Optional blnBorrar As Boolean = 0) As Boolean
Dim rst As DAO.Recordset, _
    strCriterio As String
On Error GoTo ExisteTabla_TratamientoErrores
Set rst = CurrentDb.OpenRecordset("MSysObjects", dbOpenDynaset)
' creo el criterio de busqueda
strCriterio = "Name" & " = '" & strTabla & "'"
' busca la tabla
rst.FindFirst strCriterio
If rst.NoMatch Then
    ExisteTabla = False         ' no existe
Else
    ExisteTabla = True          ' existe
    ' en caso de que así se desee elimina la tabla
    If blnBorrar Then DoCmd.DeleteObject acTable, strTabla
End If  ' rst.NoMatch
CierraRecordsetDAO rst
ExisteTabla_Salir:
    On Error GoTo 0
    Exit Function
  
ExisteTabla_TratamientoErrores:
    MsgBox "Error " & Err.Number & " en proc.: ExisteTabla de Módulo: Módulo1 (" & Err.Description & ")"
    Resume ExisteTabla_Salir
End Function            ' ExisteTabla

'*******************************************************************************
'* CierraRecordsetDAO
'* Cierra el recordset indicado
'* Argumentos: rst => recordset
'* uso: CierraRecordsetDAO rst
'* ESH 16/05/06 19:34
'*******************************************************************************
Sub CierraRecordsetDAO(rst As DAO.Recordset)
On Error Resume Next
If Not rst Is Nothing Then
    rst.Close
    Set rst = Nothing
End If
End Sub         ' CierraRecordsetDAO


-------------
Expulsado de la cárcel por robar los barrotes



Imprimir página | Cerrar ventana