Forum - Πίνακες Εξαγωγή πινάκων σε Excel

Forum (https://www.ms-office.gr/forum/)

- Access - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/access-erotiseis-apantiseis/)

- - [ Πίνακες ] Εξαγωγή πινάκων σε Excel (https://www.ms-office.gr/forum/access-erotiseis-apantiseis/2569-eksagogi-pinakon-se-excel.html)

Εξαγωγή πινάκων σε Excel

Υπάρχει τρόπος να εξάγω όλους τους πίνακες μια βάσης σε μορφή xls με την μία ή πρέπει να εξάγω έναν έναν τους πίνακες;
Ευχαριστώ.

Καλησπέρα

Εφόσον εργασθείς με VBA μπορείς να γράψεις για κάθε εξαγωγή πίνακα μια γραμμή κώδικα και τα excel να αποθηκεύονται σε όποια διεύθυνση ορίσεις...

Κώδικας:

Private Sub BtnExport_Click()

    Dim XLFileName$

    XLFileName = "C:\ ArxioXls.xls"
 

    DoCmd.TransferSpreadsheet _

            TransferType:=acExport, _

            SpreadSheetType:=acSpreadsheetTypeExcel8, _

            TableName:="tblKlados", _

            FileName:=XLFileName, _

            HasFieldNames:=True

End Sub

Στο παραπάνω παράδειγμα εξάγεται ο πίνακας tblKlados σε αρχείο excel...

Για πόσους πίνακες 'μιλάμε' ;

Με εκτίμηση

Νίκος Δ.

Παράθεση:

Αρχική Δημοσίευση από Meteora (Μήνυμα 14990)

Κώδικας:

Private Sub BtnExport_Click()

    Dim XLFileName$

    XLFileName = "C:\ ArxioXls.xls"
 

    DoCmd.TransferSpreadsheet _

            TransferType:=acExport, _

            SpreadSheetType:=acSpreadsheetTypeExcel8, _

            TableName:="tblKlados", _

            FileName:=XLFileName, _

            HasFieldNames:=True

End Sub

Μιλάμε για 250 πίνακες.

Με τον τρόπο που μου έγραψες θα πρέπει να πάω και να επαναλάβω το ίδιο για όλους τους πίνακες. Σωστά κατάλαβα;
Αν ναι γιατί να το κάνω αυτό και να μην τα κάνω χειροκίνητα?

Θες κατάλληλη ονομασία πινάκων (ή ερωτημάτων!) και δημιουργία βρόχου...Ούτε στις φυλακές δεν γράφεις τόσες φορές την ίδια γραμμή.

Αυτή είναι η πρώτη μου σκέψη

Νίκος

Μα λέω και εγω!!!!!
Ευχαριστώ πάντως πολύ.
Δεν νομίζω να τα καταφέρω γιατί δεν έχω γνώσεις απο VB.
Πάντως να είσαι καλά.
Μήπως ξέρεις πως μπορώ στην Access να βάλω συντόμευση απο το πληκτρολόγιο τύπου "ctrl+s" σε μιά ενέργεια;

Όχι, δεν γνωρίζω τόσα, ώστε να μπορώ να βοηθήσω...

Βρήκα αυτόν τον κώδικα!!!!!!
Option Compare Database
Option Explicit

Public Sub ExportDatabaseObjects()
On Error GoTo Err_ExportDatabaseObjects

Dim db As Database
'Dim db As DAO.Database
Dim td As TableDef
Dim d As Document
Dim c As Container
Dim i As Integer
Dim sExportLocation As String

Set db = CurrentDb()

sExportLocation = "D:\test\" 'Do not forget the closing back slash! ie: C:\Temp\

For Each td In db.TableDefs 'Tables
If Left(td.Name, 4) <> "MSys" Then
DoCmd.TransferText acExportDelim, , td.Name, sExportLocation & "Table_" & td.Name & ".xls", True
End If
Next td
MsgBox "All database objects have been exported as a text file to " & sExportLocation, vbInformation

Exit_ExportDatabaseObjects:
Exit Sub

Err_ExportDatabaseObjects:
MsgBox Err.Number & " - " & Err.Description
Resume Exit_ExportDatabaseObjects

End Sub

Δείχνει λογικό!!!!!!!!!
Μου βγάζει όμως ένα σφάλμα.
3027- Δεν είναι δυνατή η ενημέρωση.Η βάση δεδομένων ή το αντικείμενο είναι μόνο για ανάγνωση.
Μήπως ξέρει κάποιος τι μπορεί να φταίει;

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

Κώδικας:

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

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

Με εκτίμηση

Τάσος

Δοκίμασε το και σε λιτή έκδοση. Για να δούμε αν θα αντέξει να ...γεμίσουν 250 φύλλα το excel!!!!!

Κώδικας:

Private Sub btnAllTableExit_Click()

    Dim td As DAO.TableDef, db As DAO.Database

    Set db = CurrentDb()

    For Each td In db.TableDefs

        If Left(td.Name, 4) <> "msys" Then

            DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _

                                      td.Name, "C:\test\xExcelTables.xls", True, td.Name

        End If

    Next

End Sub

Νίκος