• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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
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
 
Ö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
 
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:
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]
.
 
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

Siz benim verdiğim kodları aynen uygulamamışsınız ....


.
 
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ı
 
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
 
kodda hata

kodu denedim ama tek satır yazdı ayrıca 5 ve 6 sütunları yan yana yaptı.
 
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....

.
 
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

.
 
Kolay gelsin.

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