[gaz_manos]

Αρχική Δημοσίευση από Tasos

Καλησπέρα!
Μάνο δοκίμασε το παρακάτω:

Option Compare Database
Option Explicit

'Εξάγει σε ένα αρχείο Excel με όλους τους πίνακες της βάσης σε χωριστά φύλλα εργασίας
'Θα πρέπει να προσαρμοστεί η διαδρομή "C:\MyFolder\"
Sub Export2Excel_Test1()
    ExportAccessTablesToExcel _
            ExportFolder:="C:\MyFolder\", _
            ExportAllTablesInOneWorkbook:=True, _
            WorkbookName:="MyBook"  ' Προσάρμοσε το όνομα
End Sub

'Εξάγει κάθε πίνακα της βάσης σε νέο βιβλίο εργασίας Excel
'Θα πρέπει να προσαρμοστεί η διαδρομή "C:\MyFolder\"
Sub Export2Excel_Test2()
    ExportAccessTablesToExcel ExportFolder:="C:\MyFolder\"
End Sub

Function ExportAccessTablesToExcel( _
         ExportFolder As String, _
         Optional ExportAllTablesInOneWorkbook As Boolean, _
         Optional WorkbookName As String)

    Dim tdfs As TableDefs
    Dim tdf As TableDef
    Dim strFileName As String
    Set tdfs = CurrentDb.TableDefs
    If Dir(ExportFolder, vbDirectory) = vbNullString Then
        MsgBox "Ο φάκελος δεν είναι διαθέσιμος!", vbExclamation
        Exit Function
    End If
    If ExportAllTablesInOneWorkbook And Len(WorkbookName) Then
        WorkbookName = ExportFolder & WorkbookName & ".xls"
    Else
        ExportAllTablesInOneWorkbook = False
    End If

    For Each tdf In tdfs
        If tdf.Attributes And dbSystemObject Then
        Else
            If ExportAllTablesInOneWorkbook Then
                DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, tdf.Name, WorkbookName, True
            Else
                strFileName = ExportFolder & tdf.Name & ".xls"
                DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, tdf.Name, strFileName, True
            End If
        End If
    Next
End Function

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

Με εκτίμηση

Τάσος

Δουλεύει πολύ καλά!!!!!!!
Το μόνο ελάττωμα είναι οτι δεν κρατάει την μορφοποίηση.
Αλλά μάλλον δεν μπορούμε να τα θέλουμε όλα δικά μας!!!!!!!!
Πάντως ευχαριστώ πάρα πολύ.