[Tasos]

Αγαπητέ Σταύρο, 

με τον παρακάτω κώδικα, νομίζω ότι λύνεις το πρόβλημα σου.



Option Compare Database

Option Explicit

Dim tmpText As String, rs As Object

' Εδώ ρυθμίζεις τα μήκη των πεδίων (Για το Pedio1 αντιστοιχεί το  Len_f1, για το Pedio2 το Len_f2 κοκ.)

Const Len_f1 = 9, Len_f2 = 10, Len_f3 = 13, Len_f4 = 42

Const Len_f5 = 2, Len_f6 = 40, Len_f7 = 40, Len_f8 = 12, Len_f9 = 12



Sub PrintTest()

    Dim fso As Object, oStream As Object

    Set fso = CreateObject("Scripting.FileSystemObject")

    Set oStream = fso.CreateTextFile(CurrentProject.Path & "\MyTextInUnicode.txt", True, True)

    Set rs = CurrentDb.OpenRecordset("Table1", dbOpenSnapshot)    ' Table1= Το όνομα του πίνακα

    With rs

        If .RecordCount = 0 Then

            .Close

            Set rs = Nothing

            MsgBox "No Data to export!"

            Exit Sub

        End If

        .MoveFirst

        WriteHeaders

        While Not .EOF

            WriteNextLine

            .MoveNext

        Wend

        .Close

        Set rs = Nothing

        oStream.Write tmpText

        oStream.Close

        Set oStream = Nothing

        Set fso = Nothing

    End With

End Sub



Function WriteHeaders() As String

' Εδώ βάλε τα ονόματα των επικεφαλίδων("Pedio1“, “Pedio1“ κτλ.). Πρόσεξε να μην υπερβαίνουν το προκαθορισμένο μήκος.

    tmpText = PrintWithSpaces("Pedio1", Len_f1)

    tmpText = tmpText & PrintWithSpaces("Pedio2", Len_f2)

    tmpText = tmpText & PrintWithSpaces("Pedio3", Len_f3)

    tmpText = tmpText & PrintWithSpaces("Pedio4", Len_f4)

    tmpText = tmpText & PrintWithSpaces("Pedio5", Len_f5)

    tmpText = tmpText & PrintWithSpaces("Pedio6", Len_f6)

    tmpText = tmpText & PrintWithSpaces("Pedio7", Len_f7)

    tmpText = tmpText & PrintWithSpaces("Pedio8", Len_f8)

    tmpText = tmpText & PrintWithSpaces("Pedio9", Len_f9)

    tmpText = tmpText & vbCrLf

End Function



Function WriteNextLine() As String

' Εδώ βάλε τα ονόματα των πεδίων  προς εγαγωγή (Pedio1, Pedio1 κτλ.

    tmpText = tmpText & PrintWithSpaces(Nz(rs.Fields("Pedio1"), vbNullString), Len_f1)

    tmpText = tmpText & PrintWithSpaces(Nz(rs.Fields("Pedio2"), vbNullString), Len_f2)

    tmpText = tmpText & PrintWithSpaces(Nz(rs.Fields("Pedio3"), vbNullString), Len_f3)

    tmpText = tmpText & PrintWithSpaces(Nz(rs.Fields("Pedio4"), vbNullString), Len_f4)

    tmpText = tmpText & PrintWithSpaces(Nz(rs.Fields("Pedio5"), vbNullString), Len_f5)

    tmpText = tmpText & PrintWithSpaces(Nz(rs.Fields("Pedio6"), vbNullString), Len_f6)

    tmpText = tmpText & PrintWithSpaces(Nz(rs.Fields("Pedio7"), vbNullString), Len_f7)

    tmpText = tmpText & PrintWithSpaces(Nz(rs.Fields("Pedio8"), vbNullString), Len_f8)

    tmpText = tmpText & PrintWithSpaces(Nz(rs.Fields("Pedio9"), vbNullString), Len_f9)

    tmpText = tmpText & vbCrLf

End Function



Function PrintWithSpaces(s$, CharCount) As String

    If Len(s) > CharCount Then s = Left(s, CharCount)

    PrintWithSpaces = s & String(CharCount - Len(s), Chr(vbKeySpace))

End Function



Φιλικά



Τάσος