vba ile txt kaydetme içine UTF-8 kodlama eklemek

C

chakistes

Katılım
17 Kasım 2009
Mesajlar
295
Excel Vers. ve Dili
2010
Altın Üyelik Bitiş Tarihi
24-12-2023
Merhaba arkadaşlar daha öncede benzer bir konu açmıştım ama cevap alamadım. Uyap türü program kullandığım için txt UTF-8 desteği olmayınca türkçe karakterleri göstermiyor. benim amacım aşağıdaki koda UTF-8 kodlaması eklemek.

With Worksheets("sayfa2")
kayıt_yeri = ThisWorkbook.Path & "\YAZDIRILACAK.txt"
atxt = FreeFile
Open kayıt_yeri For Output As #atxt
For i = 5 To Range("a65536").End(3).Row
evn = .Cells(i, 1) & vbTab
evn = evn & .Cells(i, 2) & vbTab
evn = evn & .Cells(i, 3) & vbTab
evn = evn & .Cells(i, 4) & vbTab
evn = evn & .Cells(i, 5) & vbTab
evn = evn & .Cells(i, 6) & vbTab
Print #atxt, evn
Next
Close #atxt
End With
 
Asri

Asri

Katılım
24 Nisan 2005
Mesajlar
3,669
Excel Vers. ve Dili
Office 2016 EN 64 Bit
Altın Üyelik Bitiş Tarihi
25/05/2022
Örnek olması açısında, yazmış olduğum bu programı kullanabilirsiniz.
Tam anlamı ile bu işlemi mi istiyorsunuz bilmiyorum ama,

http://www.excel.web.tr/f52/excel-vcard-telefon-rehberi-hazyrlama-programy-t166495.html

Bir kaç yıl önce bu işi kulağı tersten göstererek yapmıştım. Daha kolay bir yolu vardır mutlaka :)

Ama yıllardır sorunsuz çalışıyor :)

Bu bilgileri, vcard hazırlarken aşağıdaki şekilde uft-8 e çevirmektedir.

Deneme 1 Deneme 11 05831111111 0783 111 11 11 0883 111 11 11 0983 111 11 11 deneme@denememail.deneme Deneme Cd. Deneme Sk. N:999 İstanbul Deneme yeri 1 Müdür Müdür Müdür www.denemewebdeneme.com
Kod: 
BEGIN:VCARD
VERSION:2.1
N;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:;=44=65=6E=65=6D=65=20=31
FN;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:=44=65=6E=65=6D=65=20=31=31
TEL;CELL:05831111111
TEL;WORK:0783 111 11 11
TEL;WORK;FAX;PREF:0883 111 11 11
TEL;HOME:0983 111 11 11
EMAIL;PREF:deneme@denememail.deneme
ADR;WORK;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:;;=44=65=6E=65=6D=65=20=43=64=2E=20=44=65=6E=65=6D=65=20=53=6B=2E=20=4E=3A=39=39=39=20=C4=B0=73=74=61=6E=62=75=6C
ORG;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:=44=65=6E=65=6D=65=20=79=65=72=69=20=31
TITLE;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:=4D=C3=BC=64=C3=BC=72=20=4D=C3=BC=64=C3=BC=72=20=4D=C3=BC=64=C3=BC=72
URL:www.denemewebdeneme.com
CATEGORIES:Aile
End:VCARD
 
C

chakistes

Katılım
17 Kasım 2009
Mesajlar
295
Excel Vers. ve Dili
2010
Altın Üyelik Bitiş Tarihi
24-12-2023
merhaba benim aradığım bu değil sadece excelde userformda yazmış olduğum kod ile masa üstüne txt olarak UTF-8 formatında kaydetmek uyap programı kullanıyorum. türkçe harfleri tanımıyor.

kullandığım koda utf-8 eklemek

With Worksheets("sayfa2")
kayıt_yeri = ThisWorkbook.Path & "\YAZDIRILACAK.txt"
atxt = FreeFile
Open kayıt_yeri For Output As #atxt
For i = 5 To Range("a65536").End(3).Row
evn = .Cells(i, 1) & vbTab
evn = evn & .Cells(i, 2) & vbTab
evn = evn & .Cells(i, 3) & vbTab
evn = evn & .Cells(i, 4) & vbTab
evn = evn & .Cells(i, 5) & vbTab
evn = evn & .Cells(i, 6) & vbTab
Print #atxt, evn
Next
Close #atxt
End With
 
Son düzenleme:
H

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
∞
Merhaba;

Sorunu, text dosyasına yazdırmak için "ADODB.Stream" ve Charset olarak UTF-8 kullanarak çözebilirsiniz diye düşünüyorum.

Örneğin;

Kod: 
[COLOR=darkred][COLOR=Black]    For i = 5 To Range("a65536").End(3).Row
        evn = .Cells(i, 1) & vbTab
        evn = evn & .Cells(i, 2) & vbTab
        evn = evn & .Cells(i, 3) & vbTab
        evn = evn & .Cells(i, 4) & vbTab
        evn = evn & .Cells(i, 5) & vbTab
        evn = evn & .Cells(i, 6) & vbTab
    Next
    
    Set adoStream = CreateObject("ADODB.Stream")
    adoStream.Charset = "utf-8"
    adoStream.Type = 2
    adoStream.Open
    adoStream.WriteText [COLOR=DarkRed][B]evn[/B][/COLOR]
    adoStream.SaveToFile [COLOR=darkred][B]kayıt_yeri[/B][/COLOR]
[/COLOR][/COLOR]
.
 
C

chakistes

Katılım
17 Kasım 2009
Mesajlar
295
Excel Vers. ve Dili
2010
Altın Üyelik Bitiş Tarihi
24-12-2023
Run time eror 3004 hatası verdi

Dosya ekte olup, run time error 3004 dosyaya yazma hatası verdi.

With Worksheets("sayfa2")
kayıt_yeri = ThisWorkbook.Path & "\YAZDIRILACAK.txt"
atxt = FreeFile
Open kayıt_yeri For Output As #atxt
For i = 5 To Range("a65536").End(3).Row
evn = .Cells(i, 1) & vbTab
evn = evn & .Cells(i, 2) & vbTab
evn = evn & .Cells(i, 3) & vbTab
evn = evn & .Cells(i, 4) & vbTab
evn = evn & .Cells(i, 5) & vbTab
evn = evn & .Cells(i, 6) & vbTab

Set adoStream = CreateObject("ADODB.Stream")
adoStream.Charset = "utf-8"
adoStream.Type = 2
adoStream.Open
adoStream.WriteText evn
adoStream.SaveToFile kayıt_yeri
Print #atxt, evn
Next
Close #atxt
End With
 

Ekli dosyalar

H

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
∞
Siz benim verdiğim kodları aynen uygulamamışsınız ....


.
 
C

chakistes

Katılım
17 Kasım 2009
Mesajlar
295
Excel Vers. ve Dili
2010
Altın Üyelik Bitiş Tarihi
24-12-2023
Combile error hatası

Merhaba öncelikle yarımın için teşekkür ederim. Programda sadece sizin kodları denedim Compile error - invalid or unqualified reference hatası verdi programda uygulayıp gönderme imkanı varmı
 
E

erdem_emre

Katılım
7 Ağustos 2009
Mesajlar
45
Excel Vers. ve Dili
ofis 2000
Ben bugün balık tutmayı öğrendim

Haluk beyin kodu

Kod: 
Sub txtolustur()

kayıt_yeri = ThisWorkbook.Path & "\YAZDIRILACAK.txt"
With Worksheets("sayfa2")

[COLOR="Red"]For i = 5 To Range("a65536").End(3).Row
evn = .Cells(i, 1) & vbTab
evn = evn & .Cells(i, 2) & vbTab
evn = evn & .Cells(i, 3) & vbTab
evn = evn & .Cells(i, 4) & vbTab
evn = evn & .Cells(i, 5) & vbTab
evn = evn & .Cells(i, 6) & vbTab
Next

Set adoStream = CreateObject("ADODB.Stream")
adoStream.Charset = "utf-8"
adoStream.Type = 2
adoStream.Open
adoStream.WriteText evn
adoStream.SaveToFile kayıt_yeri[/COLOR]
End With

End Sub
 
C

chakistes

Katılım
17 Kasım 2009
Mesajlar
295
Excel Vers. ve Dili
2010
Altın Üyelik Bitiş Tarihi
24-12-2023
kodda hata

kodu denedim ama tek satır yazdı ayrıca 5 ve 6 sütunları yan yana yaptı.
 
H

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
∞
Benim, sorununuz ile ilgili önerim sadece "ADODB.Stream" kullanımı ile ilgiliydi.

Dosyanızı indirip, onun üzerinden bir çalışma yapmadım.

Bu arada, Türkçe karakter sorunu önerdiğim "ADODB.Stream" yöntemi ile çözüldü mü? Bu konuda bir yorum yapmamışınız....

.
 
C

chakistes

Katılım
17 Kasım 2009
Mesajlar
295
Excel Vers. ve Dili
2010
Altın Üyelik Bitiş Tarihi
24-12-2023
türkçe karekter düzgün gösterdi ama diğer alt satırları göstermedi.
 
H

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
∞
Kullanacağınız kod budur;

Kod: 
Private Sub CommandButton24_Click()
    kayıt_yeri = ThisWorkbook.Path & "\YAZDIRILACAK.txt"
    If Dir(kayıt_yeri) <> "" Then Kill kayıt_yeri
    For i = 5 To Range("a65536").End(3).Row
        With Worksheets("sayfa2")
            evn = evn & .Cells(i, 1) & vbTab
            evn = evn & .Cells(i, 2) & vbTab
            evn = evn & .Cells(i, 3) & vbTab
            evn = evn & .Cells(i, 4) & vbTab
            evn = evn & .Cells(i, 5) & vbTab
            evn = evn & .Cells(i, 6) & vbTab & vbCrLf
        End With
    Next
    Set adoStream = CreateObject("ADODB.Stream")
    adoStream.Charset = "utf-8"
    adoStream.Type = 2
    adoStream.Open
    adoStream.WriteText evn
    adoStream.SaveToFile kayıt_yeri
End Sub
.
 
C

chakistes

Katılım
17 Kasım 2009
Mesajlar
295
Excel Vers. ve Dili
2010
Altın Üyelik Bitiş Tarihi
24-12-2023
Teşekkür ederim istediğim gibi çalıştı
 
H

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
∞
Kolay gelsin.

.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst