Forum

Αναζήτηση στο ms-office.gr

Πάμε!
ms-office.gr > Forum > Microsoft Access > Access - Ερωτήσεις / Απαντήσεις > Εξαγωγή πινάκα σε αρχείο asci με συγκεκριμένη μορφή

Access - Ερωτήσεις / Απαντήσεις Access + VBA... Εδώ δεν υπάρχουν όρια!

Κλειστό Θέμα

 

Εργαλεία Θεμάτων Τρόποι εμφάνισης
  #1  
Παλιά 12-04-14, 00:22
Όνομα: Νάσια
Έκδοση λογισμικού Office: Ms-Office 2003
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 20-02-2014
Μηνύματα: 13
Προεπιλογή Εξαγωγή πινάκα σε αρχείο asci με συγκεκριμένη μορφή

Καλησπέρα σας!

Θα ήθελα να ρωτήσω αν έχει δυνατότητα η VBA να εξάγει 3 πίνακες σε ένα αρχείο asci της παρακάτω μορφής.
Σας στέλνω και την υποτιθέμενη βάση PELATES.zip (η οποία δημιουργήθηκε με την πολύτιμη βοήθεια ενός χρήστη του forum ) ώστε να δείτε τους πίνακες.

Στην παρακάτω μορφή αρχείου asci εμφανίζονται οι «Εξετάσεις» (με αλφαβητική σειρά) ως τίτλοι ανάμεσα στα #00 και από κάτω ακολουθούν οι «Πελάτες» που αναλαμβάνουν αυτήν την εξέταση με το Ονοματεπώνυμό τους να βρίσκεται ανάμεσα σε #01 και με το σταθερό λεκτικό «Ονοματεπώνυμο:» μπροστά από το πεδίο. Η Διεύθυνση να βρίσκεται ανάμεσα σε #02 με το σταθερό λεκτικό «Διεύθυνση:» μπροστά από το πεδίο και το Τηλέφωνο να βρίσκεται ανάμεσα σε #02 με το σταθερό λεκτικό «Τηλ:» μπροστά από το πεδίο.
(Τα bold γράμματα τα έκανα επίτηδες για να γίνει λίγο πιο ξεκάθαρο)

#00 Holter αρτηριακής πίεσης#00
#01 Ονοματεπώνυμο: ΑΘΑΝΑΣΙΟΥ ΓΕΩΡΓΙΟΣ #01
#02 Διεύθυνση: Κωνσταντινουπόλεως 5#02
#02 Τηλ. 2107777777#02
#01 Ονοματεπώνυμο: ΠΕΡΡΑΚΗΣ ΚΩΝΣΤΑΝΤΙΝΟΣ#01
#02 Διεύθυνση: Σίφνου 57#02
#02 Τηλ. 2104444444#02
#00 Triplex καρδιάς#00
#01 Ονοματεπώνυμο: ΠΑΠΑΔΟΠΟΥΛΟΣ ΔΗΜΗΤΡΙΟΣ#01
#02 Διεύθυνση: Κολοκοτρώνη 60#02
#02 Τηλ. 2105555555#02
#00 Καρδιογράφημα#00
#01 Ονοματεπώνυμο: ΑΘΑΝΑΣΙΟΥ ΓΕΩΡΓΙΟΣ #01
#02 Διεύθυνση: Κωνσταντινουπόλεως 5#02
#02 Τηλ. 2107777777#02
#01 Ονοματεπώνυμο: ΠΕΡΡΑΚΗΣ ΚΩΝΣΤΑΝΤΙΝΟΣ#01
#02 Διεύθυνση: Σίφνου 57#02
#02 Τηλ. 2104444444#02
#00 Μαγνητική τομογραφία#00
#01 Ονοματεπώνυμο: ΚΑΝΕΛΟΠΟΥΛΟΣ ΑΘΑΝΑΣΙΟΣ#01
#02 Διεύθυνση: Λεωφ. Αλεξάνδρας 145#02
#02 Τηλ. 2103333333#02
#00 ……. κλπ

Υπάρχει η δυνατότητα να γίνει το παραπάνω με VBA ή να ανατρέξω σε άλλο πρόγραμμα;

Ευχαριστώ πολύ!

Νάσια
Συνημμένα Αρχεία
Τύπος Αρχείου: zip PELATES.zip (149,0 KB, 12 εμφανίσεις)
  #2  
Παλιά 12-04-14, 18:49
Όνομα: Γιώργος
Έκδοση λογισμικού Office: Ms-Office 2010
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 18-06-2010
Μηνύματα: 3.359
Προεπιλογή

Καλησπέρα

Νάσια, στο επισυναπτόμενο αρχείο:

1) Έχω προσθέσει το ερώτημα qryExport, το οποίο περιέχει τα δεδομένα που θα εξαχθούν στο αρχείο κειμένου.

2) Τη φόρμα frmExport.

Πατώντας το κουμπί [Εξαγωγή Δεδομένων] της φόρμας, εκτελείται ο παρακάτω κώδικας που υλοποιεί το ζητούμενο.

Κώδικας:
Private Sub cmdExport_Click()
    'Απαιτείται αναφορά στο Microsofrt Scripting Runtime
    
    Dim numRec As Long, rsE As DAO.Recordset, rsP As DAO.Recordset
    Dim strSQL As String, strExit As String
    Dim fso As Object, oFile As Object, strFile As String
    Dim j As Long, strExport As String
    
    On Error GoTo Err_Trap
    
    'Εδώ καθορίζεται το αρχείο στο οποίο θα εξαχθούν τα δεδομένα
    strFile = "C:\EXETASEIS.txt"
    
    strSQL = "SELECT DISTINCT [Kwdikos_Exetashs],[Perigrafh_Exetashs] FROM qryExport ORDER BY Perigrafh_Exetashs"
    Set rsE = CurrentDb.OpenRecordset(strSQL)
    
    If rsE.RecordCount > 0 Then
        numRec = rsE.RecordCount + DCount("*", "qryExport") * 3
        ReDim strrec(1 To numRec) As String
        rsE.MoveFirst
        
        'Εδώ λαμβάνονται τα δεδομένα από το ερώτημα qryExport
        'και αποθηκεύονται στα στοιχεία του μονοδιάστατου πίνακα strRec()
        Do Until rsE.EOF
            strSQL = "SELECT [Perigrafh_Exetashs],[Onomateponymo], [Dieythinsh] ,[Thlefwno] " _
            & "FROM qryExport WHERE [Kwdikos_Exetashs]=" & rsE![Kwdikos_Exetashs] _
            & " ORDER BY [Onomateponymo]"
            Set rsP = CurrentDb.OpenRecordset(strSQL)
            rsP.MoveFirst
            j = j + 1: strrec(j) = "#00 " & rsP![Perigrafh_Exetashs] & " #00"
            Do Until rsP.EOF
                j = j + 1: strrec(j) = "#01 Ονοματεπώνυμο: " & rsP![Onomateponymo] & " #01"
                j = j + 1: strrec(j) = "#02 Διεύθυνση: " & rsP![Dieythinsh] & " #02"
                j = j + 1: strrec(j) = "#02 Τηλ: " & rsP![Thlefwno] & " #02"
                rsP.MoveNext
            Loop
            rsP.Close
            rsE.MoveNext
        Loop
        
        'Όλα τα στοιχεία του πίνακα ενώνονται στο string strExport
        'και το string αποθηκεύεται στο αρχείο κειμένου strFile
        
        strExport = Join(strrec, vbCrLf)
        Set fso = CreateObject("scripting.FileSystemObject")
        Set oFile = fso.CreateTextFile(strFile)
        oFile.WriteLine strExport
        MsgBox "Η εξαγωγή των δεδομέμων ολοκληρώθηκε." & vbCrLf & "Αρχείο: " & strFile
    End If
    
Exit_Sub:
On Error Resume Next
    oFile.Close
    rsE.Close
    rsP.Close
    Set fso = Nothing
    Exit Sub
    
Err_Trap:
    MsgBox "Error: #" & Err.Number & vbCrLf & Err.Description, "Error"
    Resume Exit_Sub
End Sub
Το αρχείο στο οποίο αποθηκεύονται, ως κείμενο, τα δεδομένα είναι το «C:\EXETASEIS.txt».

Μπορείς να το αλλάξεις τροποποιώντας τη σχετική γραμμή του κώδικα.

Γιώργος
Συνημμένα Αρχεία
Τύπος Αρχείου: mdb PELATES2.mdb (1,51 MB, 36 εμφανίσεις)
  #3  
Παλιά 13-04-14, 01:13
Όνομα: Νάσια
Έκδοση λογισμικού Office: Ms-Office 2003
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 20-02-2014
Μηνύματα: 13
Προεπιλογή

Σ' ευχαριστώ (και πάλι) Γιώργο για την άμεση απάντησή σου αλλά και για τον χρόνο που αφιέρωσες!!! Είναι αυτό που ζητούσα!!!!!!!!!!!!
Κλειστό Θέμα

Εργαλεία Θεμάτων
Τρόποι εμφάνισης

Δικαιώματα - Επιλογές
Δε μπορείτε να δημοσιεύσετε νέα μηνύματα
Δε μπορείτε να δημοσιεύσετε απαντήσεις
Δεν μπορείτε να επισυνάψετε αρχεία
Δεν μπορείτε να επεξεργαστείτε τα μηνύματα σας

Ο κώδικας ΒΒ είναι σε λειτουργία
Τα Smilies είναι σε λειτουργία
Ο κώδικας [IMG] είναι σε λειτουργία
Ο κώδικας HTML είναι εκτός λειτουργίας
Trackbacks are εκτός λειτουργίας
Pingbacks are εκτός λειτουργίας
Refbacks are εκτός λειτουργίας


Παρόμοια Θέματα

Θέμα Δημιουργός Forum Απαντήσεις Τελευταίο Μήνυμα
[ Εκθέσεις ] Εξαγωγή αρχείου σε μορφή pdf με προειδοποίηση ύπαρξης με ίδιου όνομα ΤΙΜΟΣ Access - Ερωτήσεις / Απαντήσεις 2 04-12-15 09:44
Εκτύπωση Barcodes με συγκεκριμένη μορφή pctechdr Access - Ερωτήσεις / Απαντήσεις 2 05-06-15 12:45
Μεταφορά δεδομένων από πίνακα ή ερώτημα σε νέο πίνακα με άλλη μορφή. dim.konst Access - Ερωτήσεις / Απαντήσεις 2 09-12-14 21:31
ΕΞΑΓΩΓΗ ΣΕ ΑΡΧΕΙΟ EXCEL ΤΖΙΜΗΣ Access - Ερωτήσεις / Απαντήσεις 1 01-04-11 16:42
[Access - VBA] Εξαγωγή δεδομένων σε αρχείο κειμένου. Ms-Office-Development Team Visual Basic for Applications (VBA) 0 12-12-09 20:06


Η ώρα είναι 07:31.