Θέμα: Πίνακες Εξαγωγή πινάκων σε Excel

Εμφάνιση ενός μόνο μηνύματος
  #9  
Παλιά 04-06-13, 22:00
Το avatar του χρήστη Tasos
Tasos Ο χρήστης Tasos δεν είναι συνδεδεμένος
Διαχειριστής
Όνομα: Τάσος Φιλοξενιδης
Έκδοση λογισμικού Office: Ms-Office 2016, Ms-Office 365
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική, Γερμανική
 
Εγγραφή: 21-10-2009
Μηνύματα: 2.237
Προεπιλογή

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

Κώδικας:
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
Καλή συνέχεια!

Με εκτίμηση

Τάσος
__________________
Ms-Office Development Team
Ανάπτυξη επαγγελματικών εφαρμογών
Απάντηση με παράθεση