[Αναστάσιος Αναγνωστάκης]

Καλησπέρα και χρόνια πολλά με υγεία.

Θα ήθελα για άλλη φορά την πολύτιμη βοήθεια σας σε ότι αφορά ένα αρχείο ASC που βγάζω.
Ποιος είναι ο κώδικας για να μπορώ να το βγάζω σε συγκεκριμένη κωδικοσελίδα.
Ο κώδικας είναι του Κ' Φιλοξενίδη Αναστάσιου και είναι ο παρακάτω:

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

Με ορισμένες τροποποιήσεις - αλλαγές, Δουλεύει άψογα, αλλά θέλω να βγάζω το αρχείο, σε μια συγκεκριμένη κωδικοσελίδα, γιατί τα φορητά των οδηγών, ΔΕΝ διαβάζουν το αρχείο που βγαίνει. Μερικά πειράματα που έκανα, ΜΟΝΟ με την κωδικοσελίδα Codepage 437 (United States, Canada), δουλεύει....Οποιαδήποτε άλλη, αποτυγχάνει.
Σας Ευχαριστώ

Φιλικά

Αναστάσιος