Ανανέωση ιστοσελίδας

[Ms-Office-Development Team]

Επειδή τελευταία γίνεται πολύς λόγος για δημιουργία κειμένων σταθερού μήκους
αλλά και εξαγωγή πινάκων db σε αρχεία κειμένου, ίσως φανεί χρήσιμος ο παρακάτω κώδικας
σε όσους αντιμετωπίζουν συχνά τέτοιου είδους εργασίες:

Option Compare Database
Option Explicit

Sub TestCTFFR()
    Dim rst As Recordset

    Set rst = CurrentDb.OpenRecordset("Table1", dbOpenSnapshot)
    On Error Resume Next
    If CreateTextFileFromRecordset(rst, "C:\TestFile.txt", 10, 20, 20, 0, 15, 15) Then
        MsgBox "Text file created succesfully.", vbInformation
    Else
        MsgBox "Unable to create text file.", vbExclamation
    End If
    If Err Then MsgBox Err.Description, vbExclamation
    rst.Close
    Set rst = Nothing
End Sub
        
Function CreateTextFileFromRecordset( _
        ByVal Rs As Recordset, _
        ByVal strFileName As String, _
        ParamArray ColsWidth() As Variant) As Boolean
    
    Dim strTemp As String
    Dim hFile As Long
    Dim intLBnd As Integer
    Dim intUBnd As Integer
    Dim i As Integer
    
    intLBnd = LBound(ColsWidth)
    intUBnd = UBound(ColsWidth)

    On Error GoTo ErrHandler
    If intUBnd >= intLBnd Then
        If Not Rs Is Nothing Then
            With Rs
                If intUBnd > .Fields.Count - 1 Then
                    intUBnd = .Fields.Count - 1
                End If
                If .RecordCount Then
                    For i = intLBnd To intUBnd
                        strTemp = strTemp _
                            & FixedString(.Fields(i).Name, ColsWidth(i))
                    Next i
                    strTemp = strTemp & vbCrLf & vbCrLf
                    
                    .MoveFirst
                    While Not .EOF
                        For i = intLBnd To intUBnd
                            strTemp = strTemp & FixedString(Nz(.Fields(i), _
                                vbNullString), ColsWidth(i))
                        Next i
                        strTemp = strTemp & vbCrLf
                        .MoveNext
                    Wend
                    If Len(strTemp) Then
                        hFile = FreeFile
                        Open strFileName For Output As hFile
                        Print #hFile, strTemp
                        CreateTextFileFromRecordset = True
                    End If
                End If
            End With
        End If
    End If
ExitProc:
    Close hFile
    Exit Function
ErrHandler:
    Err.Raise Err.Number, "CreateTextFileFromRecordset", Err.Description
    Resume ExitProc
End Function

Function FixedString(strIn As String, _
        Optional ByVal intLen As Integer = 10, _
        Optional ByVal fAlignLeft As Boolean = False) As String
        
    Dim strTemp As String
    
    If intLen > 0 Then
        strTemp = String(intLen, " ")
        If Len(strIn) Then
            If fAlignLeft Then
                LSet strTemp = strIn
            Else
                RSet strTemp = strIn
            End If
        End If
    End If
    FixedString = strTemp
End Function

Οι διαδικασίες "CreateTextFileFromRecordset"και "FixedString" είναι γενικής χρήσης
και μπορούμε να τις χρησιμοποιήσουμε σε οποιοδήποτε έργο καλώντας τις όπως φαίνεται στο παραπάνω παράδειγμα.

Συγκεκριμένα, η συνάρτηση "FixedString", επιστρέφει ένα αλφαριθμητικό τύπου String ορισμένου μήκους
το οποίο περιέχει το αλφαριθμητικό που της ορίζουμε, στοιχισμένο στην επιθυμητή πλευρά.

Οι παράμετροι που αναμένει είναι οι εξής:
strIn
Απαιτείται. Έκφραση τύπου String.
Το προς προσαρμογή αλφαριθμητικό.
intLen
Προαιρετική. Έκφραση τύπου Integer.
Το μήκος του αλφαριθμητικού εξόδου. Προεπιλεγμένη τιμή: 10
fAlignLeft
Προαιρετική. Έκφραση τύπου Boolean.
Στοίχιση του αλφαριθμητικού εισόδου αριστερά. Προεπιλεγμένη τιμή: False

Η συνάρτηση λειτουργεί ως εξής:
Το μήκος σε χαρακτήρες του αλφαριθμητικού που επιστρέφει ισούται με την τιμή του ορίσματος "intLen".
Αν το μήκος του ορίσματος "strIn" είναι μικρότερο από την τιμή του ορίσματος "intLen",
οι επιπλέον θέσεις γεμίζουν με χαρακτήρες διαστήματος (" ").
Αν το μήκος του ορίσματος "strIn" είναι μεγαλύτερο από την τιμή του ορίσματος "intLen",
η συνάρτηση αφαιρεί τους επιπλέον χαρακτήρες του αλφαριθμητικού εισόδου από το τέλος του.
Αν το όρισμα "strIn" είναι μια τιμή κενού αλφαριθμητικού ("") και το όρισμα "intLen" μεγαλύτερο του μηδενός,
το αλφαριθμητικό εξόδου αποτελείται μόνο από χαρακτήρες διαστήματος.
Αν το όρισμα "intLen" είναι μηδέν, η συνάρτηση επιστρέφει ένα αλφαριθμητικό μηδενικού μήκους ("").
Η στοίχιση του αλφαριθμητικού εισόδου εξαρτάται από την τιμή του ορίσματος "fAlignLeft".
Η προεπιλεγμένη τιμή είναι False και το αλφαριθμητικού εισόδου εμφανίζεται στα δεξιά του αλφαριθμητικού εξόδου.

Η συνάρτηση "CreateTextFileFromRecordset" δημιουργεί ένα αρχείο κειμένου (αν δεν υπάρχει ήδη)
από τα δεδομένα ενός αντικειμένου Recordset οργανωμένα σε στήλες σταθερού μήκους.
Η επιστρεφόμενη τιμή της είναι απλά μια ενημέρωση για την επιτυχία ή την αποτυχία της δημιουργίας του αρχείου.
Προσοχή!
Η συνάρτηση δεν αναρτά τα νέα δεδομένα σε υπάρχον αρχείο αλλά αντικαθιστά με αυτά τα ήδη υπάρχοντα.

Οι παράμετροι της "CreateTextFileFromRecordset" είναι οι εξής:
Rs
Απαιτείται. Ένα έγκυρο αντικείμενο Recordset.
Το αντικείμενο Recordset το οποίο περιέχει τα δεδομένα που θα εξαχθούν στο αρχείο κειμένου.
strFileName
Απαιτείται. Έκφραση τύπου String.
Η πλήρη διαδρομή και το όνομα του αρχείου εξόδου.
Παράδειγμα: "C:\TestFile.txt"
ColsWidth
Απαιτείται. Λίστα τιμών τύπου Integer.
Μια λίστα ορισμάτων με το πλάτος των στηλών του κειμένου που θα αντιστοιχούν στα πεδία του Recordset.
Οι μηδενικές τιμές σε αυτή τη λίστα αποκρύπτουν τα αντίστοιχα πεδία στο αρχείο εξόδου.

Ένα παράδειγμα κλήσης της συνάρτησης "CreateTextFileFromRecordset" είναι η διαδικασία "TestCTFFR".
Συγκεκριμένα, αυτή η διαδικασία δημιουργεί ένα αρχείο κειμένου με διαδρομή "C:\TestFile.txt"
από ένα Recordset το οποίο περιέχει τουλάχιστον έξι πεδία από έναν πίνακα με όνομα "Table1"
της τρέχουσας βάσης δεδομένων.
Σε αυτό το παράδειγμα το τέταρτο πεδίο του Recordset δεν θα εκτυπωθεί στο αρχείο κειμένου
διότι η αντίστοιχη τιμή στα ορίσματα πλάτους έχει οριστεί ίση με μηδέν.
...CreateTextFileFromRecordset(rst, "C:\TestFile.txt", 10, 20, 20, 0, 15, 15)...

Ελπίζουμε να σας φανούν χρήσιμες.