** NORMAS DEL FORO **
Inicio del foro Inicio del foro > Access y VBA > Access y VBA
  Mensajes nuevos Mensajes nuevos RSS - EXTRAER DATOS DE TABLA VINCULADA CON ADOX
  Preguntas frecuentes Preguntas frecuentes  Buscar en el foro   Eventos   Registro Registro  Iniciar sesion Iniciar sesion

EXTRAER DATOS DE TABLA VINCULADA CON ADOX

 Responder Responder
Autor
Mensaje
dornier134 Ver desplegable
Nuevo
Nuevo
Avatar

Unido: 10/Mayo/2018
Localización: Badajoz
Estado: Sin conexión
Puntos: 9
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita dornier134 Cita  ResponderRespuesta Enlace directo a este mensaje Tema: EXTRAER DATOS DE TABLA VINCULADA CON ADOX
    Enviado: 02/Abril/2019 a las 10:32
Hola!!

Estoy trabajando en una aplicación que permita la conexión con archivos Excel (cualquiera, no es un archivo fijo) que extraiga en un listbox de las tablas que tenga el archivo al que vaya a conectar.

He conseguido vincular las tablas Excel y extraer a un listbox las tablas sin problemas.

Yendo un paso mas allá, pretendo pinchar en cualquiera de las tablas extraidas y que en ese momento me extraiga a otro listbox los datos de las tablas.

El problema es que cuando hago esto, los registros no pasan a la tabla hasta que no hago un refresh del segundo listbox, debiendo además esperar unos momentos (las tablas tienen pocos registros, no es por el tamaño de los datos...)

Este sería el código por el que extraigo y muestro las tablas.

Ruta es una variable Public a nivel de modulo...

Private Sub cmdConectar_Click()

    'abro dialogo
    Set AbrirArchivo = Application.FileDialog(msoFileDialogOpen)
    'filtro y seleccion de archivo
    With AbrirArchivo

        .Title = "Selecciona el archivo que quieres abrir...."
        .Filters.Clear
        .Filters.Add "Archivos Excel", "*.xls,*.xlsx,*.xlsm,*.xlsb"
        .InitialFileName = Empty
        .InitialFileName = "Selecciona..."

        If .Show = -1 Then
            Ruta = .SelectedItems.Item(1)
            Call EstableceConexion(Ruta)
        Else
            Beep
            MsgBox "No se realizó ninguna selección" _
            , vbInformation + vbOKOnly, _
            "Seleccionar archivo"
        End If

    End With

End Sub


Public Sub EstableceConexion(nRuta As String)
Dim conexion As ADODB.Connection

'CON ADOX
Dim cat As ADOX.Catalog
Dim tablas As ADOX.Tables
Dim nTabla As ADOX.Table
Dim campos As LongPtr

On Error GoTo ErrorControl:

lstTablas.RowSource = Empty
lstTablas.RowSourceType = "value list"
lstTablas.ColumnCount = 3
lstTablas.ColumnHeads = True
lstTablas.ColumnWidths = "10cm;3cm;5cm"

lstTablas.AddItem "Nombre" & ";" & "Tipo" & ";" & "Campos"

    DoCmd.Hourglass True

    Set conexion = New ADODB.Connection

    conexion.Open (DeterminaCadenaDeConexion(Ruta))
    
    Set cat = New Catalog
    
    cat.ActiveConnection = conexion
    
    Set tablas = cat.Tables
       
    For Each nTabla In tablas
       
        campos = nTabla.Columns.Count

        lstTablas.AddItem nTabla.Name & _
        ";" & nTabla.Type & _
        ";" & campos
    
    Next
   
    cat.Tables.Refresh
              
    conexion.Close
   
    Set conexion = Nothing
    
    DoCmd.Hourglass False
    
    Exit Sub

ErrorControl:
    
    DoCmd.Hourglass False
    
    Beep
    MsgBox "No se ha podido conectar con el archivo", vbOKOnly + vbCritical, "Error en conexión"

End Sub


Private Function DeterminaCadenaDeConexion(pruta As String) As String
Dim mElementos() As String
Dim Extension As String
Dim pCadenaDeConexion As String

On Error GoTo ErrorControl:

    'Split a la cadena de ruta en matriz
    mElementos = Split(pruta, ".")
    'el ultimo elemento es la extension
    Extension = mElementos(UBound(mElementos()))
    'ahora discrimino por el valor obtenido
    'pongo valor a la propiedad cadena de conexion
    Select Case Extension
        Case Is = "xlsx", "XLSX"
            pCadenaDeConexion = "Provider= Microsoft.ACE.OLEDB.12.0;" _
            & "Data Source=" & pruta & ";" _
            & "Extended Properties=""Excel 12.0 Xml;HDR=YES;"""
        Case Is = "xlsm", "XLSM"
            pCadenaDeConexion = "Provider=Microsoft.ACE.OLEDB.12.0;" _
            & "Data Source=" & pruta & ";" _
            & "Extended Properties=""Excel 12.0 Macro;HDR=YES"""
        Case Is = "xls", "XLS"
            pCadenaDeConexion = "Provider=Microsoft.ACE.OLEDB.12.0;" _
            & "Data Source=" & pruta & ";" _
            & "Extended Properties=""Excel 8.0;HDR=YES"""
        Case Is = "xlsb", "XLSB"
            pCadenaDeConexion = "Provider=Microsoft.ACE.OLEDB.12.0;" _
            & "Data Source=" & pruta & ";" _
            & "Extended Properties=""Excel 12.0;HDR=YES"""
        Case Else
            pCadenaDeConexion = Empty
    End Select

'devuelvo la cadena de conexión
DeterminaCadenaDeConexion = pCadenaDeConexion

Exit Function

ErrorControl:
    'informo de error
    Beep
    MsgBox "Se produjo el error " & Err.Number & " en tiempo de ejecución" _
    & vbNewLine & "Descripción de error: " & Err.Description _
    & vbNewLine & "Proceso (Clase Conexión Externa): DeterminaCadenaDeConexion" _
    , vbCritical + vbOKOnly, _
    "Se detectó un error"

    'no devuelvo cadena de conexion
    DeterminaCadenaDeConexion = Empty

Exit Function

End Function


Private Sub lstTablas_Click()
'NOTA, Tabla es una variable publica también a nivel de modulo
Tabla = lstTablas.Column(0, lstTablas.ListIndex + 1)
End Sub


El problema lo veo aquí, este es el proceso que trata de poner como origen de datos la tabla extraída

Private Sub Extraer_Click()
Dim cat As ADOX.Catalog
Dim tbl As ADOX.Table
Dim campos As LongPtr

    Set cat = New ADOX.Catalog
    
    cat.ActiveConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" _
            & "Data Source=" & CurrentDb.Name & ";Persist Security Info=False;"
    
    Set tbl = New ADOX.Table
    
    tbl.Name = Tabla
    
    Set tbl.ParentCatalog = cat
    
    With tbl
    
        .Properties("Jet OLEDB:Link Datasource") = Ruta
        .Properties("Jet OLEDB:Remote Table Name") = Tabla
        .Properties("Jet OLEDB:Create Link") = True
        .Properties("Jet OLEDB:Link Provider String") = "Excel 12.0;HDR=YES"
    
    End With
    
    cat.Tables.Append tbl
    
    campos = tbl.Columns.Count
    
    cat.Tables.Refresh

    lstDatos.ColumnCount = campos
    lstDatos.ColumnHeads = True
    lstDatos.ColumnWidths = Empty
    lstDatos.RowSource = Empty
    lstDatos.RowSource = tbl.Name


End Sub

Para que el código funcione tengo que poner en otro botón aparte el requery del listbox lstDatos. ¿Qué puede ocurrir?¿Que estoy haciendo mal?

También quisiera consultaros como enviar comandos a la tabla vinculada para realizar filtros adicionales si no quiero extraer todos los datos o traérmelos ya filtrados o bien para poder realizar cuantas consultas desee a la tabla vinculada.

Muchas gracias a todos de antemano
Juanjo
Arriba
pitxiku Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 27/Septiembre/2017
Localización: En mi casa
Estado: Sin conexión
Puntos: 996
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita pitxiku Cita  ResponderRespuesta Enlace directo a este mensaje Enviado: 04/Abril/2019 a las 11:20
Un par de preguntas:

Quieres crear un vínculo a cada hoja excel cada vez que el usuario la seleccione?

Por que no usas Dao o Ado para acceder a la hoja? Podrás usar sentencias sql y filtrar los datos.
Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable