** NORMAS DEL FORO **
Inicio del foro Inicio del foro > Access y VBA > Tus Funciones Favoritas & Aportaciones & Artí­culos
  Mensajes nuevos Mensajes nuevos RSS - Listado de tablas en Base Externa
  Preguntas frecuentes Preguntas frecuentes  Buscar en el foro   Eventos   Registro Registro  Iniciar sesion Iniciar sesion

Tema cerradoListado de tablas en Base Externa

 Responder Responder
Autor
Mensaje
buho Ver desplegable
Administrador
Administrador
Avatar
Abuelo FELIZ

Unido: 10/Abril/2004
Localización: Valladolid
Estado: Sin conexión
Puntos: 11317
Enlace directo a este mensaje Tema: Listado de tablas en Base Externa
    Enviado: 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
Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable