En este video aprenderás a conectar Excel con Access, compartiendo funciones y datos entre estas dos fantásticas aplicaciones.

Espero que os guste.

Este es el código del video:

Option Compare Database
Option Explicit

Public Sub test()

    capturarFuncionPromedioExcel CurrentProject.Path & "\miExcel.xlsm", True

End Sub


Public Function capturarFuncionPromedioExcel(rutaExcel As String, Optional bolOculto As Boolean = False) As Variant
    
    
    On Error GoTo Control_Error
    
    
    Dim excelApp As Object
    Dim excelfile As Object
    Dim excelHoja As Object
    
    Dim strSQL As String
    Dim datAhora As Date
    Dim varPromedio As String
    Dim strHojaExcel As String
    
    Set excelApp = CreateObject("Excel.Application")
    If Not bolOculto Then excelApp.Visible = True
    Set excelfile = excelApp.Workbooks.Open(rutaExcel, False)
    
    datAhora = Now()
    ' Captura el dato
    varPromedio = Str(excelfile.Application.Run("basExcel.promedioMatriz"))
    strSQL = "INSERT INTO tblPromedios (Fecha, Promedio) VALUES (#" & datAhora & "#, " & varPromedio & ")"
    
    
    Debug.Print datAhora & " - " & varPromedio
    
    ' Guarda el dato

    CurrentDb.Execute strSQL
    
    strHojaExcel = "log"
    
    Set excelHoja = excelfile.Sheets(strHojaExcel)
    ' Envia el dato
    
'    Debug.Print ultimaFila(excelHoja)
    
    excelHoja.cells(ultimaFila(excelHoja) + 1, 1).Value = "Última captura realizada el " & datAhora & ". El valor obtenido fue de " & varPromedio
    
   
Control_Error:

    On Error Resume Next


    If rutaExcel <> "" Then
        excelfile.Save
        If bolOculto Then excelApp.Quit

            If Not (excelHoja Is Nothing) Then
            Set excelHoja = Nothing
        End If

        If Not (excelfile Is Nothing) Then
            Set excelfile = Nothing
        End If
        If Not (excelApp Is Nothing) Then
            Set excelApp = Nothing
        End If
    End If

End Function


Private Function ultimaFila(excelHoja As Object, Optional columna As Long = 1) As Long
    On Error Resume Next
    ultimaFila = excelHoja.Columns(columna).Find("*", _
        searchorder:=1, searchdirection:=2).Row
End Function

No responses yet

Deja una respuesta

Tu dirección de correo electrónico no será publicada.