[Tasos]

Καλημέρα σε όλους!

Αγαπητέ Δημήτρη, δοκίμασε το παρακάτω:

Καλή συνέχεια!

Option Compare Database

Option Explicit



Function CalculateInXL()

    Dim XLFileName As String, xl As Object, wb As Object

    On Error GoTo ExportErr

    XLFileName = "C:\POI.xlsb"

    DoCmd.TransferSpreadsheet _

            TransferType:=acExport, _

            SpreadSheetType:=acSpreadsheetTypeExcel8, _

            TableName:="NEXT", _

            FileName:=XLFileName, _

            HasFieldNames:=True

ExportErr:

    If Err Then

        MsgBox Err.Description

        Exit Function

    End If

    On Error GoTo XLErr

    Set xl = CreateObject("Excel.Application")

    Set wb = xl.Workbooks.Open(XLFileName)

    If xl.Calculation <> -4105 Then xl.Calculatefull

    wb.Save

    wb.Close False

    xl.Quit

    Set xl = Nothing

XLErr:

    If Err Then

        On Error Resume Next

        If Not xl Is Nothing Then xl.Visible = True

        If Not wb Is Nothing Then Set wb = Nothing

        If Not xl Is Nothing Then Set xl = Nothing

        MsgBox Err.Description

        Exit Function

    End If

    On Error GoTo ImportErr

    DoCmd.TransferSpreadsheet _

            TransferType:=acImport, _

            SpreadSheetType:=acSpreadsheetTypeExcel8, _

            TableName:="poi", _

            FileName:=XLFileName, _

            HasFieldNames:=True, _

            Range:="poi!A1:CS3"

    MsgBox "Finished!!", vbInformation, "Transfer to EXCEL"

ImportErr:

    If Err Then MsgBox Err.Description

End Function