modifier encodage fichier txt ( UTF8 en ANSI ) en VBA

Question

Bonjour,

je ne connais pas VB6. J'ai un code VBA qui appartient à une macro BO et je dois le faire évoluer.

Cette macro Bo exporte les données d'états BO dans un fichier texte. Ce fichier texte est encodé UTF-8.

J'ai besoin de modifier l'encodage de ce fichier texte pour de l'ANSI. j'ai adapté le script suivant mais ca plante sur la ligne en gras.

pourriez-vous m'aider, SVP? 


Sub ModifEncodage(ByVal file_source As String, ByVal file_destination As String)

    Const ForReading 1, ForWriting 2, ForAppending = 8
    Const ModeAscii 0, ModeUnicode -1
    Dim fso, f_in, f_out
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    
Set f_in = fso.openTextFile(file_source, ForReading, , ModeUnicode)
Set f_out = fso.openTextFile(file_destination, ForWriting, True, ModeAscii)
Dim Line() As Byte

Do Until f_in.AtEndOfStream
    Line = StrConvf_in.readline,vbFromUnicode)
    f_out.writeline Line
Loop
f_in.Close
f_out.Close

End Sub


ensuite, je n'ai pas encore codé mais il faut que je supprime f_in et renomme f_out en f_in.

merci d'avance.

Utilisateur anonyme · Answer

Bonjour,

Désolé, mais la ligne en gras a disparu. Pour faciliter la lecture du code, il est demandé et même très apprécié de mettre le code en forme. C'est avec la troisième icône à partir de la gauche.

ucfoutu · Answer

Bonjour,
1) Déclarer des constantes au sein d'une procédure est assez (pour le moins) surprenant (mais ça passe).  
2) cette ligne de code est totalement incompréhensible :
Line = StrConvf_in.readline,vbFromUnicode) 

Qu'est-elle donc supposée faire, selon toi ?
________________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'en cas de nécessité de développ

ucfoutu · Answer

Bon ... Je suppose que tu voulais appliquer la fonction StrConv à un texte (sans même respecter la syntaxe d'une fonction !) Cela ne te mènerait pas vraiment loin, de toutes manières. J'ai ressorti de mes vieux tiroirs un petit bout de code pour les barbares. Essaye de voir ce qu'il fait (tant dans un sens que dans l'autre). Le voici : Option Explicit Private Sub CommandButton1_Click() Dim toto As String, titi As String toto = "Notre texte de départ, écrit comme chez nous, c'est à dire comme ça " MsgBox "voilà notre texte de départ" & vbCrLf & toto titi = en_uft8(toto) MsgBox "voilà comment l'a torturé Monsieur UFR8" & vbCrLf & titi MsgBox " voilà comment on corrige titi pour le rendre ""buvable""" & vbCrLf & en_comme_chez_soi(titi) End Sub Private Function en_uft8(texte) As String Dim c As Integer, i As Integer, texte_uft8 As String texte_uft8 = "" i = 1 Do While i <= Len(texte) c = AscW(Mid(texte, i, 1)) If c < 128 Then texte_uft8 = texte_uft8 + Chr(c) ElseIf ((c >= 128) And (c < 2048)) Then texte_uft8 = texte_uft8 + Chr(((c \ 64) Or 192)) texte_uft8 = texte_uft8 + Chr(((c And 63) Or 128)) ElseIf ((c >= 2048) And (c < 65536)) Then texte_uft8 = texte_uft8 + Chr(((c \ 4096) Or 224)) texte_uft8 = texte_uft8 + Chr((((c \ 64) And 63) Or 128)) texte_uft8 = texte_uft8 + Chr(((c And 63) Or 128)) Else texte_uft8 = texte_uft8 + Chr(((c \ 262144) Or 240)) texte_uft8 = texte_uft8 + Chr(((((c \ 4096) And 63)) Or 128)) texte_uft8 = texte_uft8 + Chr((((c \ 64) And 63) Or 128)) texte_uft8 = texte_uft8 + Chr(((c And 63) Or 128)) End If i = i + 1 Loop en_uft8 = texte_uft8 End Function Private Function en_comme_chez_soi(texte) Dim ou1 As Integer, ou2 As Integer, ou3 As Integer, ou4 As Integer, ahah As String, i As Integer If si_barbare(texte) = False Then en_comme_chez_soi = texte: Exit Function End If ahah = "" i = 1 Do While i <= Len(texte) ou1 = Asc(Mid(texte, i, 1)) If i <= Len(texte) - 1 Then ou2 = Asc(Mid(texte, i + 1, 1)) Else ou2 = 0 End If If i <= Len(texte) - 2 Then ou3 = Asc(Mid(texte, i + 2, 1)) Else ou3 = 0 End If If i <= Len(texte) - 3 Then ou4 = Asc(Mid(texte, i + 3, 1)) Else ou4 = 0 End If If (ou1 And 240) 240 And (ou2 And 128) 128 And (ou3 And 128) = 128 And (ou4 And 128) = 128 Then ahah = ahah + ChrW((ou1 - 240) * 65536 + (ou2 - 128) * 4096) + (ou3 - 128) * 64 + (ou4 - 128) i = i + 4 ElseIf (ou1 And 224) 224 And (ou2 And 128) 128 And (ou3 And 128) = 128 Then ahah = ahah + ChrW((ou1 - 224) * 4096 + (ou2 - 128) * 64 + (ou3 - 128)) i = i + 3 ElseIf (ou1 And 192) 192 And (ou2 And 128) 128 Then ahah = ahah + ChrW((ou1 - 192) * 64 + (ou2 - 128)) i = i + 2 ElseIf (ou1 And 128) = 128 Then ahah = ahah + ChrW(ou1 And 127) i = i + 1 Else ahah = ahah + ChrW(ou1) i = i + 1 End If Loop en_comme_chez_soi = ahah End Function Private Function si_barbare(texte) Dim ou1 As Integer, ou2 As Integer, ou3 As Integer, ou4 As Integer, i As Integer si_barbare = True i = 1 Do While i <= Len(texte) ou1 = Asc(Mid(texte, i, 1)) If i <= Len(texte) - 1 Then ou2 = Asc(Mid(texte, i + 1, 1)) Else ou2 = 0 End If If i <= Len(texte) - 2 Then ou3 = Asc(Mid(texte, i + 2, 1)) Else ou3 = 0 End If If i <= Len(texte) - 3 Then ou4 = Asc(Mid(texte, i + 3, 1)) Else ou4 = 0 End If If (ou1 And 240) = 240 Then If (ou2 And 128) 128 And (ou3 And 128) 128 And (ou4 And 128) = 128 Then i = i + 4 Else si_barbare = False: Exit Function End If ElseIf (ou1 And 224) = 224 Then If (ou2 And 128) 128 And (ou3 And 128) 128 Then i = i + 3 Else si_barbare = False: Exit Function End If ElseIf (ou1 And 192) = 192 Then If (ou2 And 128) = 128 Then i = i + 2 Else si_barbare = False: Exit Function End If ElseIf (ou1 And 128) = 0 Then i = i + 1 Else si_barbare = False: Exit Function End If Loop End Function ________________________ Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches. Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'en cas de nécessité de développ

cs_Tricette · Answer

Merci de vos commentaires. 

la ligne en gras c'est le write.

Line StrConvf_in.readline,vbFromUnicode  > oubli affreux de parenthèse ( mais pas dans mon code sinon ca aurait planter à ce niveau)
ce qu'il faut lire : Line = StrConv(f_in.readline,vbFromUnicode) L'objectif de ce code est de prendre dans le premier fichier texte nommé f_in,chaque ligne, ligne par ligne, en la convertissant en ANSI et de l'écrire dans le 2è fichier.

Pour la synthaxe et le code : vous avez pu mesurer que je suis une grande débutante en VB.

Merci pour vous réponses. j'en saurais plus jeudi car je ne travaille pas le mercredi.

MarcPL · Answer

Le code d'ucfoutu est complet, il m'aurait bien servi il y a quelques temps ... Pour un besoin de modifier des infos de fichiers PVR, j'ai créé ceci convenant bien aux caractères français : Function Utxt(ByVal S As String) As String For N = 1 To Len(S) C = Mid(S, N, 1) A = Asc(C) If A > 169 Then C = "Ã" & Chr(A - 64) Utxt = Utxt & C Next End Function Function Wtxt(ByVal S As String) As String L = Len(S) For N = 1 To L C = Mid(S, N, 1) If C = "Ã" And N < L Then A = Asc(Mid(S, N + 1)) If A > 105 And A < 192 Then C = Chr(A + 64) N = N + 1 End If End If Wtxt = Wtxt & C Next End Function La fonction Utxt convertit un texte Windows, la fonction Wtxt convertit un texte UTF, si cela peut aider ... ___________________________________________________________________________________________________________________ Comme la vitesse de la lumière est supérieure à celle du son, certains ont l'air brillant avant d'avoir l'air con !

Modifier encodage fichier txt ( UTF8 en ANSI ) en VBA

5 réponses

Votre réponse

Discussions similaires