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

stephsteph · 27 Septembre 2016

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

Hieu · 27 Septembre 2016

Salut,

En faisant une recherche rapide "encodage d'un fichier txt vba",
On trouve une solution qui semble marcher :

VB:

Set fs= CreateObject("ADODB.Stream")
fs.Charset = "UTF-8"

source : http://www.developpez.net/forums/d2...acros-vba-excel/vba-e-fichiers-texte-utf-8-a/

stephsteph · 29 Septembre 2016

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 · 29 Septembre 2016

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 · 29 Septembre 2016

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 · 30 Septembre 2016

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 · 30 Septembre 2016

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

stephsteph · 5 Octobre 2016

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 · 6 Octobre 2016

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 · 6 Octobre 2016

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

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?

stephsteph · 7 Octobre 2016

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 · 7 Octobre 2016

Bonsoir à tous

stephsteph à dit:
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 · 10 Octobre 2016

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

Staple1600 · 10 Octobre 2016

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 · 11 Octobre 2016

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

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

stephsteph

XLDnaute Occasionnel

Hieu

XLDnaute Impliqué

stephsteph

XLDnaute Occasionnel

Staple1600

XLDnaute Barbatruc

Hieu

XLDnaute Impliqué

stephsteph

XLDnaute Occasionnel

Staple1600

XLDnaute Barbatruc

stephsteph

XLDnaute Occasionnel

stephsteph

XLDnaute Occasionnel

Staple1600

XLDnaute Barbatruc

stephsteph

XLDnaute Occasionnel

Staple1600

XLDnaute Barbatruc

stephsteph

XLDnaute Occasionnel

Pièces jointes

Staple1600

XLDnaute Barbatruc

stephsteph

XLDnaute Occasionnel

Discussions similaires