Question de conversion en UTF-8 pour une VBA qui enregistre un txt

stephsteph

XLDnaute Occasionnel
Bonjour le forum,


J’ai une macro VBA qui marche bien qui après plusieurs opérations sur un fichier xlsm, enregistre le résultat dans un fichier txt avec le code :

Set fs = CreateObject("Scripting.FileSystemObject")

Set a = fs.CreateTextFile(ThisWorkbook.Path & "\" & Liste(i - 1) & ".txt", True)

Le résultat délivré est, après ouverture de Notepad++, en caractères ANSI.

Je dois passer maintenant en UTF-8 et j’ai cherché sur le Net comment modifier le codage pour cela, je n’ai trouvé qu’une seule référence en Anglais qui indique qu’il faut ajouter un autre true comme :

Set a = fs.CreateTextFile(ThisWorkbook.Path & "\" & Liste(i - 1) & ".txt", True, True)

Hélas le résultat obtenu est en UCS-2 LE BOM , pas en UTF-8.


Quelqu’un a une idée ?

Merci de votre aide

Steph
 

stephsteph

XLDnaute Occasionnel
Bonjour Hieu,




Ah, bonne remarque, je n’avais pas googelisé avec ces termes (mais avec le titre de fil).

J’ai testé mais cela ne marche pas avec Xlsm2007.

Si je fais :

Set fs = CreateObject("Scripting.FileSystemObject")

fs.Charset = "UTF-8"

Set a = fs.CreateTextFile(ThisWorkbook.Path & "\" & Liste(i - 1) & ".txt", True)

J’ai un message d’erreur à fs.Charset = "UTF-8" (surligné en jaune) avec

erreur d'exécution '438'. Propriété ou méthode non géré par cet objet



Ou si je fais :

Set fs= CreateObject("ADODB.Stream")

fs.Charset = "UTF-8"

Set a = fs.CreateTextFile(ThisWorkbook.Path & "\" & Liste(i - 1) & ".txt", True)

Alors j’ai le même message d’erreur à Set a = fs.CreateTextFile(ThisWorkbook.Path & "\" & Liste(i - 1) & ".txt", True) (surligné en jaune)




J’ai cherché cette erreur 438 (il y a beaucoup de réponses y compris même un correctif de Microsoft), mais rien de concordant (mais je ne connais pas bien du tout set fs)

Qu’en penses-tu ?

A+

Steph
 

Staple1600

XLDnaute Barbatruc
Bonjour à tous

Fonctionne sur Excel 2013
VB:
Sub testUTF8()
Dim fsTrm As Object
Set fsTrm = CreateObject("ADODB.Stream")
With fsTrm
.Type = 2
.Charset = "utf-8"
.Open
.WriteText "Ligne de test"
'adapter le chemin
.SaveToFile "C:\NOMDOSSIER\TestUTF8.txt", 2
End With
End Sub
 

Hieu

XLDnaute Impliqué
Salut,

Dans le meme esprit :
VB:
Sub mlk()
Dim fs As Object
Set fs = CreateObject("ADODB.Stream")
fs.Open
fs.writetext "uuu"
fs.Position = 0
fs.Charset = "UTF-8"
fs.Savetofile ThisWorkbook.Path & "\" & "toto.txt"

End Sub
 

stephsteph

XLDnaute Occasionnel
Bonjour Staple 1600 et Yieu,

Tout d’abord merci de votre soutien.

Et toutes mes excuses car depuis le début j’étais partie (à tort) pour une modif mineure de mon code ‘type True, True’ comme initialement indiqué, dans Set a = fs.CreateTextFile(ThisWorkbook.Path & "\" & Liste(i - 1) & ".txt", True).

Bon Staple 1600 (qui m’a déjà aidée sur un autre post), je n’ai pas pu tester car j’ai une erreur de code (mis en rouge) dans l’adaptation de la ligne

.SaveToFile "C:\NOMDOSSIER\TestUTF8.txt", 2 (le contrôleur indique qu’il attend un ‘=’)

Il est possible que ce soit un souci entre mon Excel 2007 et ton Excel 2013.

Yieu, j’ai pu tester mais j’ai Erreur d'exécution '3004'

Impossible d'écrire dans le fichier

avec fs.Savetofile (ThisWorkbook.Path & "\" & Liste(i - 1) & ".txt") surligné en jaune

Mon souci c’est que j’en ai une bonne quinzaine de macros que je dois adapter et qu’elles ne sont pas toutes pareilles !

Et notamment j’en ai une série qui se termine par (pour créer un csv qui aujourd’hui avec notepad++ s’ouvre en ANSI !)

ActiveWorkbook.SaveAs Filename:="C:\_dossier\sousdossier\fichier1.csv", FileFormat:=xlCSV, Local:=True, CreateBackup:=False

Enfin si notre discussion me permet de régler l’UTF-8 pour la présente macro ce sera toujours cela de gagner.

Voici mon code… si vous pouviez le modifier, et expliquer chaque modif pour que je comprenne bien la démarche, et quand elle marchera, j’essaierai alors d’adapter les autres (sinon je ferai manuellement avec notepad++).

Code:
Option Explicit


Sub blabla0()

  Dim fs As Object, a As Object, i As Long, j As Long, k As Long, Ligne As String, Liste

  Sheets("test").Select

  'Liste des noms à parcourir et à enregistrer

  Liste = Array("blabla1", " blabla2", " blabla3")

  Set fs = CreateObject("Scripting.FileSystemObject")

  'i passe de 1 à i pour les i plages

  For i = 1 To 3

  'on sélectionne les plages une à une

  Application.Goto Reference:=Liste(i - 1)

  'on crée le fichier

  Set a = fs.CreateTextFile(ThisWorkbook.Path & "\" & Liste(i - 1) & ".txt", True)

  'Pour chaque ligne  de la plage

  For j = 1 To Range(Liste(i - 1)).Rows.Count

  Ligne = ""

  'Pour chaque colonne de la ligne on colle les informations avec un séparateur tabulation (chr(9))

  For k = 1 To Range(Liste(i - 1)).Columns.Count

  Ligne = Ligne & Range(Liste(i - 1)).Cells(j, k).Value & Chr(9)

   Next k

  If Len(Ligne) > 0 Then Ligne = Left(Ligne, Len(Ligne) - 1)

  'On écrit la ligne dans le fichier texte

  a.writeline Ligne

  Next j

  'on ferme le fichier

  a.Close

  Next i

  Set a = Nothing

  Set fs = Nothing

  End Sub


A+ donc et en renouvelant mes excuses, merci pour votre patience.


Steph
 

Staple1600

XLDnaute Barbatruc
Bonjour à tous

stephsteph

Copie cette macro dans un module standard, dans un classeur de test et enregistre le en *.xlsm
Puis lance la macro
VB:
Sub testUTF8_BIS()
Dim strPath$
strPath = ThisWorkbook.Path & "\"
Dim fsTrm As Object
Set fsTrm = CreateObject("ADODB.Stream")
With fsTrm
.Type = 2
.Charset = "utf-8"
.Open
.WriteText "Ligne de test"
.SaveToFile strPath & "TestUTF8.txt", 2
End With
CreateObject("WScript.Shell").Run strPath & "TestUTF8.txt"
End Sub
Normalement, tu dois voir le fichier Text s'ouvrir dans le Bloc-Notes
Et si tu fais dans le bloc-notes Fichier-> Enregistrer sous tu constates qu'il est bien en UTF-8
utf8.jpg
 

stephsteph

XLDnaute Occasionnel
Bonjour JM (Staple 1600),



Merci de ton aide.

Cette fois la vba marche sous Xlsm2007, mais avec un problème qui semble bloquer.

C’est effectivement, sous MS bloc notes, du UTF-8…

Mais quand j’ouvre le fichier avec notepad++, le format est UTF8-BOM et comme tu l’imagines il faut UTF-8 sans BOM (l’objectif est ici de déployer du code pour le standard actuel html 5 du W3C).

Qu’en penses-tu ?

A+, Stephsteph
 

stephsteph

XLDnaute Occasionnel
Bonjour Staple 1600,



Je ne reste pas inactive !

En fonction des discussions précédentes sur ce fil j’ai pu googeliser à nouveau et mieux, et j’ai trouvé une discussion en Anglais pile poil sur le UTF-8 avec ou sans bom.

Je copie ci-après le message du forum en Anglais (j’ai capté grosso modo -bof- l’Anglais… mais pas du tout le code VBA, puis j’ai testé tout bêtement comme pour ta proposition précédente et bingo cela a marché et j’ai eu 2 fichiers ‘toto’, un avec bom, l’autre sans bom dans notepad ++.

Donc on tient le cap… reste à démêler le code ‘Anglais’ (cela semble jouable mais je ne suis pas sûre à 100%) pour enlever tout ce qui concerne le ‘avec bom’, puis à me dire ce qu’il faut changer dans mon code à moi (avec liste i-1 etc) pour que cela marche dans mon cas pratique (dans le code ‘anglais’ il y a seulement WriteText "aÄö" pour tester).

Puis je compter sur toi ?

Merci d’avance

Stephsteph


Texte et code ‘Anglais’ :

In the best of all possible worlds the Related list would contain a reference to this question which I found as the first hit for "vbscript adodb.stream bom vbscript site:stackoverflow.com".



Based on the second strategy from boost's answer:

Option Explicit

Sub Macrotest()

Const adSaveCreateNotExist = 1

Const adSaveCreateOverWrite = 2

Const adTypeBinary = 1

Const adTypeText = 2



Dim objStreamUTF8 : Set objStreamUTF8 = CreateObject("ADODB.Stream")

Dim objStreamUTF8NoBOM : Set objStreamUTF8NoBOM = CreateObject("ADODB.Stream")



With objStreamUTF8

.Charset = "UTF-8"

.Open

.WriteText "aÄö"

.Position = 0

.SaveToFile "toto.php", adSaveCreateOverWrite

.Type = adTypeBinary

.Position = 3

End With



With objStreamUTF8NoBOM

.Type = adTypeBinary

.Open

objStreamUTF8.CopyTo objStreamUTF8NoBOM

.SaveToFile "toto-nobom.php", adSaveCreateOverWrite

End With



objStreamUTF8.Close

objStreamUTF8NoBOM.Close

xxxxx

Evidence:

chcp

Active code page: 65001


dir

...

15.07.2015 18:48 5 toto-nobom.php

15.07.2015 18:48 8 toto.php



type toto-nobom.php

aÄö
 

Staple1600

XLDnaute Barbatruc
Bonsoir à tous

1)
Qu’en penses-tu ?
Que depuis le début, il manque un fichier Excel dans ce fil fourni par le demandeur ;) pour que l'on puisse faire des tests:rolleyes:

2)
Puis je compter sur toi ?
Goto 1)

En attendant ton fichier, j'ai suivi ton lien, et j'ai modifié un chouia ceci (glané sur le net)
VB:
Sub WriteUTF8WithoutBOM()
Dim UTFStream As Object, BinaryStream As Object
With CreateObject("adodb.stream")
    .Type = 2
    .Mode = 3
    .Charset = "UTF-8"
    .LineSeparator = -1
    .Open
    .WriteText "This is an unicode/UTF-8 test.", 1
    .WriteText "First set of special characters: öäåñüûú€", 1
    .WriteText "Second set of special characters: qwertzuiopõúasdfghjkléáûyxcvbnm\|Ä€Í÷×äðÐ[]í³£;?¤>#&@{}<;>*~¡^¢°²`ÿ´½¨¸0", 1
    .Position = 3 'skip BOM
    Set BinaryStream = CreateObject("adodb.stream")
        BinaryStream.Type = 1
        BinaryStream.Mode = 3
        BinaryStream.Open
    'Strips BOM (first 3 bytes)
    .CopyTo BinaryStream
    .Flush
    .Close
End With
        BinaryStream.SaveToFile "C:\CHANGER_ICI_LENOM_DU_DOSSIER\test.txt", 2
        BinaryStream.Flush
        BinaryStream.Close
End Sub
Est-ce que chez toi, le fichier texte créé est bien comme tu le souhaites?
 
Dernière édition:

stephsteph

XLDnaute Occasionnel
Bonjour Staple 1600,


Merci à nouveau.

Tu as directement trouvé le code pur (sans le code avec Bom). Chapeau.
Cela marche nickel sur un fichier test vide.

Donc ce qu’il me faut maintenant c’est les modifications dans mon code (qui produit du ANSI) avec le code UTF-8 sans BOM que tu as trouvé pour qu’il produise les mêmes résultats mais avec UTF-8 sans BOM

Je reprend mon code qui marche

Code:
Option Explicit


Sub blabla0()

  Dim fs As Object, a As Object, i As Long, j As Long, k As Long, Ligne As String, Liste

  Sheets("PnL").Select

  'Liste des noms à parcourir et à enregistrer

  Liste = Array("blabla1", " blabla2", " blabla3")

  Set fs = CreateObject("Scripting.FileSystemObject")

  'i passe de 1 à i pour les i plages

  For i = 1 To 3

  'on sélectionne les plages une à une

  Application.Goto Reference:=Liste(i - 1)

  'on crée le fichier

  Set a = fs.CreateTextFile(ThisWorkbook.Path & "\" & Liste(i - 1) & ".txt", True)

  'Pour chaque ligne  de la plage

  For j = 1 To Range(Liste(i - 1)).Rows.Count

  Ligne = ""

  'Pour chaque colonne de la ligne on colle les informations avec un séparateur tabulation (chr(9))

  For k = 1 To Range(Liste(i - 1)).Columns.Count

  Ligne = Ligne & Range(Liste(i - 1)).Cells(j, k).Value & Chr(9)

  Next k

  If Len(Ligne) > 0 Then Ligne = Left(Ligne, Len(Ligne) - 1)

  'On écrit la ligne dans le fichier texte

  a.writeline Ligne

  Next j

  'on ferme le fichier

  a.Close

  Next i

  Set a = Nothing

  Set fs = Nothing

  End Sub


J’imagine que

Code:
a.writeline Ligne
correspond, dans Sub WriteUTF8WithoutBOM(), à

Code:
WriteText "This is an unicode/UTF-8 test.", 1

  .WriteText "First set of special characters: öäåñüûú€", 1

  .WriteText "Second set of special characters: qwertzuiopõúasdfghjkléáûyxcvbnm\|Ä€Í÷×äðÐ[]í³£;?¤>#&@{}<;>*~¡^¢°²`ÿ´½¨¸0", 1
Mais au-delà je suis bien paumée!
Donc à+, Steph... Mais

Si cela ne suffit pas bien sûr je peux créer un xlsm modèle avec 3 champs blabla1, 2, 3 et dedans le code qui marche et produit du ANSI, sans problème (alors je le préparerai ce WE)
 

Staple1600

XLDnaute Barbatruc
Bonsoir à tous

Bonjour Staple 1600,
Si cela ne suffit pas bien sûr je peux créer un xlsm modèle avec 3 champs blabla1, 2, 3 et dedans le code qui marche et produit du ANSI, sans problème (alors je le préparerai ce WE)
Pile poil ce que j'attendais depuis le 27 septembre ;)
 

stephsteph

XLDnaute Occasionnel
Bonjour Staple 1600,

Et bravo pour ton sens de l'humour (j'ajoute l'icône que tu connais!).

Voilà j'ai pu avoir accès à l'ordi avec les fichiers ce WE et je te joins le xlsm test (j'ai vérifié).

Merci de ton aide (avec si possible plein de lignes commentées pour les autres vba que je dois modifier aussi)

A+

Steph
 

Fichiers joints

Staple1600

XLDnaute Barbatruc
Bonsoir à tous

Pas sur d'avoir compris le but de la manœuvre
En modifiant l'existant comme cela, ça donne quoi ?
VB:
Sub blabla()
   Dim i As Long, j As Long, k As Long, Ligne As String, Liste
   Sheets("PnL").Select
       'Liste des noms à parcourir et à enregistrer
       Liste = Array("blabla1", "blabla2", "blabla3")
          'i passe de 1 à i pour les i plages
       For i = 1 To 3
       'on sélectionne les plages une à une
       Application.Goto Reference:=Liste(i - 1)
       'on crée le fichier
          'Pour chaque ligne  de la plage
          For j = 1 To Range(Liste(i - 1)).Rows.Count
              Ligne = ""
              'Pour chaque colonne de la ligne on colle les informations avec un séparateur tabulation (chr(9))
              For k = 1 To Range(Liste(i - 1)).Columns.Count
                  Ligne = Ligne & Range(Liste(i - 1)).Cells(j, k).Value & Chr(9)
              Next k
              If Len(Ligne) > 0 Then Ligne = Left(Ligne, Len(Ligne) - 1)
              'On écrit la ligne dans le fichier texte
             WriteUTF8WithoutBOM Ligne, ThisWorkbook.Path & "\" & Liste(i - 1) & ".txt"
          Next j
       Next i
   End Sub
Function WriteUTF8WithoutBOM(chaine As String, nomfichier As String)
Dim UTFStream As Object, BinaryStream As Object
With CreateObject("adodb.stream")
    .Type = 2
    .Mode = 3
    .Charset = "UTF-8"
    .LineSeparator = -1
    .Open
    .WriteText chaine, 1
    .Position = 3 'skip BOM
   Set BinaryStream = CreateObject("adodb.stream")
        BinaryStream.Type = 1
        BinaryStream.Mode = 3
        BinaryStream.Open
    'Strips BOM (first 3 bytes)
   .CopyTo BinaryStream
    .Flush
    .Close
End With
        BinaryStream.SaveToFile nomfichier, 2
        BinaryStream.Flush
        BinaryStream.Close
End Function
 

stephsteph

XLDnaute Occasionnel
Bonjour Staple 1600,



Un grand merci car ton code VBA astucieusement utilise une fonction décalée à la fin et donc les modifs que j’aurai à faire sur mes multiples fichiers seront mineures et localisées.

Tout d’abord je vais répondre à ta question : la macro crée des fichiers texte d’après des champs Excel très remplis et qui sont souvent actualisés, ensuite les fichiers textes sont inclus dans les pages web via un include (une fonction en php). Par exemple j’ai tout un site qui est automatiquement actualisé de la sorte. Très très bien pour moi !

Bon maintenant les ‘mauvaises’ nouvelles.

En deux mots la macro marche, mais elle ne fait pas le job :

Elle ne reprend pas l’intégralité des 3 champs sélectionnés (elle prend seulement la dernière ligne de chacun des champs)

Elle ne transcode pas en UTF-8 sans bom (mais reste en ANSI)

Donc je me suis dit, peut-être que c’est mon fichier… alors j’ai testé avec le fichier que j’ai mis sur le forum et j’ai copié ta macro dedans sans modif… et c’est pareil (le même double problème).

Tu peux tester toi-même facilement.



Là je suis sèche de chez sèche !



A+, Steph
 

Staple1600

XLDnaute Barbatruc
Bonsoir àtous

Apparemment c'est mieux au niveau du contenu des *.txt
Mais c'est toujours pas çà.
VB:
Sub blabla()
'Cocher ces réferences
' Microsoft ADO Ext.  6.0 for DDL and Security
' Microsoft ActiveX Data Objects 2.7 Library
Dim stream As New ADODB.stream
Dim i As Long, j As Long, k As Long, Ligne As String, Liste
Sheets("PnL").Select
'Liste des noms à parcourir et à enregistrer
Liste = Array("blabla1", "blabla2", "blabla3")
    'i passe de 1 à i pour les i plages
    For i = 1 To 3
       'on sélectionne les plages une à une
    Application.Goto Reference:=Liste(i - 1)
    'on crée le fichier
    stream.Open
    stream.Type = adTypeText
    stream.Charset = "utf-8"
          'Pour chaque ligne  de la plage
          For j = 1 To Range(Liste(i - 1)).Rows.Count
              Ligne = ""
              'Pour chaque colonne de la ligne on colle les informations avec un séparateur tabulation (chr(9))
              For k = 1 To Range(Liste(i - 1)).Columns.Count
                  Ligne = Ligne & Range(Liste(i - 1)).Cells(j, k).Value & Chr(9)
              Next k
              If Len(Ligne) > 0 Then Ligne = Left(Ligne, Len(Ligne) - 1)
              'On écrit la ligne dans le fichier texte
    stream.WriteText Ligne, 1
          Next j
          'on ferme le fichier
    stream.Position = 3 'skip BOM
    Dim BinaryStream As New ADODB.stream
    BinaryStream.Type = adTypeBinary
    BinaryStream.Mode = adModeReadWrite
    BinaryStream.Open
    ' Strips BOM (first 3 bytes)
    stream.CopyTo BinaryStream
    stream.Flush
    stream.Close
    BinaryStream.SaveToFile ThisWorkbook.Path & "\" & Liste(i - 1) & ".txt", adSaveCreateOverWrite
    BinaryStream.Flush
    BinaryStream.Close
    Next i
   End Sub
 

Staple1600

XLDnaute Barbatruc
Re à tous

Après quelques recherches sur le Web, j'ai testé ceci
1) On créé d'abord le fichier UTF-8
On vérifie dans le bloc-notes qu'on est bien en UTF-8
2) On lance Supprime_UTF8_Bom
Et on s'aperçoit dans le bloc-note qu'on est désormais en ANSI
Donc au final, je passe mon tour ;)
NB: Il faut cocher les références à Microsoft Scripting Runtime dans VBE
VB:
Public Const UTF8_BOM = ""
Public Const UTF16BE_BOM = "þÿ"
Public Const UTF16LE_BOM = "ÿþ"
Sub testUTF8()
Dim fsTrm As Object
Set fsTrm = CreateObject("ADODB.Stream")
With fsTrm
.Type = 2
.Charset = "utf-8"
.Open
.WriteText "Ligne de test"
.SaveToFile ThisWorkbook.Path & "\" & "Test1UTF8.txt", 2
End With
End Sub
Sub Supprime_UTF8_Bom()
'emprunté à :Christoph Schneegans
Dim F As String, t As String
Dim fso As New FileSystemObject
F = ThisWorkbook.Path & "\" & "Test1UTF8.txt"
t = fso.OpenTextFile(F, ForReading).ReadAll
If Left(t, 3) = UTF8_BOM Then
fso.OpenTextFile(F, ForWriting).Write (Mid(t, 4))
MsgBox "BOM supprimé"
Else
MsgBox "UTF-8-BOM non reconnu"
End If
End Sub
 

stephsteph

XLDnaute Occasionnel
Bonjour Staple 1600, bonjour le forum,



Merci de tous tes efforts en espérant que l’on va s’en sortir !

J’ai testé sur xlsm 2007 la macro proposée hier à 19h15.

Malheureusement elle bugue à

Dim stream As New ADODB.stream

Surligné en bleu avec une boîte qui dit

Erreur de compilation

Type défini par l’utilisateur non défini



Voilà

Il reste que la macro modèle que tu avais trouvé Jeudi dernier à 19h48 marchait chez moi avec 2007 et produisait du UTF-8 sans Bom... reste l'adaptation à ma macro qui apparaît comme très ardue!

Encore merci!

A+ peut-être

Steph
 

stephsteph

XLDnaute Occasionnel
Bonjour Staple 1600

Désolée de t'avoir énervé.
Aucune intention.
Je n'avais pas vu les 3 lignes de commentaires.
Je suis incompétente là.
Cocher ces 2 lignes?

' Microsoft ADO Ext. 6.0 for DDL and Security
' Microsoft ActiveX Data Objects 2.7 Library

Comment?
J'ai trouvé une réponse (très vieille) sur ce forum pour la 1ère, si elle est toujours valide.
Mais rien pour la seconde.

Je veux bien essayer si j'apprend comment les cocher.

Mais d'abord des questions.
Si on me dit comment faire, ta macro ne fera quand même pas le job (sauf erreur de ma part de compréhension de ton message), alors intérêt?
Si je le fais est-ce que cela aura un impact négatif sur mes dizaines de macro VBA Excel existantes (prudence inutile ?)
Les macros dans les fils en Anglais ne parlent pas de ces bibliothèques spéciales et elles marchent sans (là je suis carrément paumée).

Toujours merci!

A+

Steph
 

Discussions similaires


Haut Bas