Ανανέωση ιστοσελίδας
ms-office.gr > Forum > Microsoft Access > Access - Ερωτήσεις / Απαντήσεις > Κωδικοσελίδα αρχείου Asc

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

Απάντηση στο θέμα

 

Εργαλεία Θεμάτων Τρόποι εμφάνισης
  #1  
Παλιά 10-04-18, 14:21
Όνομα: Αναστάσιος Πολ
Έκδοση λογισμικού Office: Ms-Office 2003, Ms-Office 2010
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 29-11-2012
Μηνύματα: 13
Προεπιλογή Κωδικοσελίδα αρχείου Asc

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

Θα ήθελα για άλλη φορά την πολύτιμη βοήθεια σας σε ότι αφορά ένα αρχείο 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), δουλεύει....Οποιαδήποτε άλλη, αποτυγχάνει.
Σας Ευχαριστώ

Φιλικά

Αναστάσιος
Συνημμένα Αρχεία
Τύπος Αρχείου: zip PELAT.zip (1,1 KB, 5 εμφανίσεις)
Απάντηση με παράθεση
Απάντηση στο θέμα


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

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


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

Θέμα Δημιουργός Forum Απαντήσεις Τελευταίο Μήνυμα
Εξαγωγή αρχείου σε .asc Nasia Access - Ερωτήσεις / Απαντήσεις 5 01-06-14 23:16
Επισκευή Αρχείου. gaz_manos Access - Ερωτήσεις / Απαντήσεις 1 20-02-13 18:26
[ Ασφάλεια] Κλείδωμα Αρχείου Free_Ghost Access - Ερωτήσεις / Απαντήσεις 12 19-02-10 10:08


Η ώρα είναι 12:54.