Excel Forum - Porady, Pomoc, Excel Help, Excel FAQ - Zapisz jako txt + formatowanie

wiorek · Exceloholic Posty: 132

Hej,

Próbuję dopasować zapisywanie arkusza w formacie txt i kodowaniu utf-8 ale nie wychodzi. Może ktoś z Was ma jakiś pomysł ? Internet przeszukany, nie dałem rady.

Poniżej makro, którego używam

Kod:

Sub savetxt()

Dim csvFiles(1 To 3) As String, i As Integer
Dim wsName As Variant
Dim OutApp As Object, OutMail As Object

i = 0
For Each wsName In Array("Sheet4") 'nazwa arkusza
i = i + 1
csvFiles(i) = ThisWorkbook.Path & "\" & wsName & Format(Now(), "dd-mm-yyyyhhmmss") & ".txt"
ThisWorkbook.Worksheets(wsName).Copy
ActiveWorkbook.SaveAs csvFiles(i), FileFormat:=xlTextPrinter
'FileFormat:=xlCSVUTF8
ActiveWorkbook.Close False
Next

End Sub

Jak używam

Kod:

' FileFormat:=xlTextPrinter

to zapisuje się plik OK, ale mam w Excelu polskie znaki i tworzą się krzaki

jak zamienię zapisywanie na

Kod:

'FileFormat:=xlCSVUTF8

to nie ma krzaków, ale dodają się cudzysłowy np. jest

Kod:

"""data"": {"

a powinno być

Kod:

"data": {

Macie jakiś pomysł, jak zapisać arkusz w kodowaniu UTF-8, z zachowaniem polskich znaków i bez dodawania cudzysłowów ?

Tajan · **Pomógł:** 5573 razy Posty: 12088

Trochę "na okrętkę" ale powinno działać:

Kod:

Sub savetxt()
Dim csvFiles(1 To 3) As String, i As Integer
Dim wsName As Variant
Dim OutApp As Object, OutMail As Object
Dim tmpFile As String
Dim st1 As Object, st2 As Object

Const adSaveCreateOverWrite = 2
Const adTypeText = 2

tmpFile = ThisWorkbook.Path & "\TMPFILE.TXT"
i = 0

For Each wsName In Array("Sheet4") 'nazwa arkusza
i = i + 1
csvFiles(i) = ThisWorkbook.Path & "\" & wsName & Format(Now(), "dd-mm-yyyyhhmmss") & ".txt"
ThisWorkbook.Worksheets(wsName).Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs tmpFile, FileFormat:=xlTextPrinter
Application.DisplayAlerts = True
'FileFormat:=xlCSVUTF8
ActiveWorkbook.Close False

Set st1 = CreateObject("ADODB.Stream")
Set st2 = CreateObject("ADODB.Stream")

With st1
.Charset = "Windows-1250"
.Type = adTypeText
.Open
.LoadFromFile tmpFile
End With

With st2
.Charset = "utf-8"
.Type = adTypeText
.Open
.WriteText st1.ReadText
.SaveToFile csvFiles(i), adSaveCreateOverWrite
End With

st1.Close
st2.Close
Kill tmpFile

Next

End Sub

wiorek · Exceloholic Posty: 132

wiorek · Exceloholic Posty: 132

Hej,
Właściwie jest jeszcze jeden problem, wczytywałem wczoraj wszystkie dane z "ó" i pokazywało się poprawnie, sprawdziłem dzisiaj inne polskie znaki, i na nich niestety wykrzacza.

"ąćęłńóśżź"

pokazuje się w txt po zapisie jako

"?????ó???"

Tajan · **Pomógł:** 5573 razy Posty: 12088

Nadal zapisujesz jako "FileFormat:=xlTextPrinter"? U mnie to działa. Sprawdziłem. Załącz przykładowy plik Excela oraz błędny plik tekstowy, wykonany na jego podstawie.

tekst.jpg

Plik ściągnięto 16 raz(y) 98.1 KB

arkusz.jpg

Plik ściągnięto 15 raz(y) 46.29 KB

wiorek · Exceloholic Posty: 132

Tajan · **Pomógł:** 5573 razy Posty: 12088

No, nie wiem... U mnie działa normalnie. Masz polską wersję Excela i Windowsa?

UTF8_txt.jpg

Plik ściągnięto 16 raz(y) 21.63 KB

Sheet408-12-2023124922.txt

Pobierz Plik ściągnięto 53 raz(y) 150 Bajtów

wiorek · Exceloholic Posty: 132

Tajan · **Pomógł:** 5573 razy Posty: 12088

Spróbuj zmienić:

Kod:

.Charset = "Windows-1250"

np. na

Kod:

.Charset = "Windows-1252"

bo chyba tutaj należy szukać przyczyny. Nie mam doświadczenia z innymi wersjami narodowymi, więc nie bardzo wiem jak ten problem rozwiązać. Jezeli nie pomoże to "zakomentuj" linię:

Kod:

Kill tmpFile

postaraj się sprawdzić z jaką stroną kodową został zapisany plik "TMPFILE.TXT" i odpowiednio dostosuj "Charset" streama "ts1".