TXT dosyası oluşturma

[burhancavus61]

m3 m500 sütunlarında olan bilgileri txt dosyasına nasıl aktarabiliriz. bi türlü beceremedim. yardımlarınızı bekliyorum.

 

[Ferhat Pazarçevirdi]

Merhabalar

Aşağıdaki VBA kodunu kullanabilirsiniz. C:\ kök dizinin altına TextDosyam.txt adlı bir dosya yaratır. Siz; yolu ve ismi değiştirebilirsiniz.

Sub Texte_Yaz()
Dim fso As Object
Dim i%
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists("C:\TextDosyam.txt") Then
   With fso.GetFile("C:\TextDosyam.txt").OpenAsTextStream(8)
       For i = 3 To 500
           .writeline Cells(i, "M")
       Next i
       .Close
   End With
Else
    With fso.CreateTextFile("C:\TextDosyam.txt")
       For i = 3 To 500
           .writeline Cells(i, "M")
       Next i
        .Close
    End With
End If
Set fso = Nothing
End Sub

 

[burhancavus61]

ekleme

merhaba cevabınız için teşekkürler
verdiğiniz koda aşağıdaki kodları yerleştirebilirmiyiz

DosyaAdi = InputBox("Dosya Adını Belirtiniz", "GATAB", "")
If DosyaAdi = "" Then Exit Sub
Dosya = "C:\" & DosyaAdi & ".txt"

benim için daha kullanışlı olur

 

[Ferhat Pazarçevirdi]

O zaman, kodunuzu aşağıdaki gibi revize edin.

Sub Texte_Yaz()
Dim fso As Object
Dim i%
Dim dosyaadi As String, TamYol As String
dosyaadi = InputBox("Dosya Adını Belirtiniz", "GATAB", "")
If dosyaadi = "" Then: Exit Sub
TamYol = "C:\" & dosyaadi & ".txt"
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(TamYol) Then
   With fso.GetFile(TamYol).OpenAsTextStream(8)
       For i = 3 To 500
           .writeline Cells(i, "M")
       Next i
       .Close
   End With
Else
    With fso.CreateTextFile(TamYol)
       For i = 3 To 500
           .writeline Cells(i, "M")
       Next i
        .Close
    End With
End If
Set fso = Nothing
End Sub

 

[burhancavus61]

teşekkür

teşekkür ederim sayın fpc
verdiğiniz kodlar çok işime yaradı

 

[hurkanpisirici]

merhaba bu kodları modül kısmınamı yazıyoruz acaba?

 

[Ferhat Pazarçevirdi]

merhaba bu kodları modül kısmınamı yazıyoruz acaba?

Evet .......

 

[hurkanpisirici]

teşekkür ederim sayın fpc

 

[CRAYZLOVEIS]

Aynı soruya ilave olarak bende bir şey sormak istiyorum. Bu soruda arkadaş M3 M500 arası verilerin kaydedilmesini istemiş. Peki aynı kodu A1 hücresinden H1 Hücresine kadar olan verilerin kaydedilmesini istersek nasıl bir düzenleme yapmamız gerekir.

Ama burada önemli olan nokta satırlarda ne kadar veri varsa hepsini txt olarak kaydetsin. Yani arkadaşın sorunsunda olduğu gibi 500. satır diye bir sınırlandırma olmasın. Sayfada ne varsa txt olarak kaydetsin.. Tşk

 

[ftekin]

Ek'te dosyadaki gibi birşey yaptım.
TXT'ye çevirirken veri hücrelerinin belli bir karakter uzunluğu olmalı.Yoksa ekolayzer gibi zig zag bir görüntü olur ve okutma yapacak olursan sıhhatli olmaz.EK'teki örnekte karakter hücrelere 15 karakter uzunluğu, rakamsal olanlara 10 hane uzunluk vererek TXT'ye dönüştürme yaptırdım.
Umarım işine yarar.

Kolay gelsin..

 

[CRAYZLOVEIS]

Arkadaşım hazırladığın dosya için sağol. Ama bu şekilde olmadı.. Diğer hücreleride A ve B sütunundaki veriler gibi kaydederse olacak sanırım.

 

[ftekin]

O zaman aşağıdaki gibi kullan

Private Sub CommandButton1_Click()
Dim fNumber As Integer
Dim Buffer As String
Dim SatırNo As Long

Dim Baslangic As String * 15
Dim Varis As String * 15
Dim x1 As String * 10
Dim x2 As String * 10
Dim x3 As String * 10
Dim x4 As String * 10
Dim x5 As String * 10
Dim x6 As String * 10


Dim dosyaadi As String, TamYol As String
dosyaadi = InputBox("Dosya Adını Belirtiniz", "GATAB", "")
If dosyaadi = "" Then: Exit Sub

If Dir("C:\" & dosyaadi & ".txt") <> vbNullString Then
Kill "C:\" & dosyaadi & ".txt"
End If

fNumber = FreeFile
Open "C:\" & dosyaadi & ".txt" For Output As fNumber
Do While True
SatırNo = SatırNo + 1
Rows(SatırNo & ":" & SatırNo).Select
Baslangic = Cells(SatırNo, 1)
Varis = Cells(SatırNo, 2)
x1 = Cells(SatırNo, 3)
x2 = Cells(SatırNo, 4)
x3 = Cells(SatırNo, 5)
x4 = Cells(SatırNo, 6)
x5 = Cells(SatırNo, 7)
x6 = Cells(SatırNo, 8)

If Cells(SatırNo, 1) = vbNullString And Cells(SatırNo, 2) = vbNullString Then Exit Do

Buffer = Baslangic & Varis & x1 & x2 & x3 & x4 & x5 & x6


Print #fNumber, Buffer
Loop
Close (fNumber)
End Sub

 

[CRAYZLOVEIS]

Üstad yardım çabaların için sağol ama maalesef yine olmadı. Nasıl bir txt dosyası istediğimi ekledim. Yani bildiğin excel sayfasını farklı kaydet - metin sekmeyle ayrılmış özelliğini kullanarak oluşan txt dosyası lazım. Yaparsan büyük sevaba girersin.. Olmazsa da canın sağolsun ben bu işten vazgeçerim. Tşk.

 

[ftekin]

Hocam merhaba,

İyi güzel de, Excel sayfasında iken Farklı kaydet - Metin (Sekmeyle ayrılmış) dediğimizde senin istediğin şekilde TXT oluşturmuyorki(Bende oluşan TXT EK'te) .Yani görüntü olarak aynı değil.Üstelik benim excel versiyonu da sizinki ile aynı.Şimdi böyle deneme yanılma yoluyla çözüme ulaşmak yerine ihtiyaçlarını tam olarak belirtirsen daha kesin çözüme ulaşırız.

Şu soruyu önce bir çözüme ulaştıralım;
Siz bu TXT'ye dönüştüreceğiniz verileri neyle ve nasıl tekrar çözümleteceksiniz?


TXT dosyalarda ana mantık sekme felan değil her veri sütununun belli karakter uzunluğunda oluşturulması ve çözümlemede bu karakter aralıklarının dikkate alınarak çözümlenmesi esastır.Mesela 10 sütun olan verilerin 10'ar karakter uzunluğunda olmaları ve txt satır uzunluğunun 100 karakter olması gibi.

İllaki de ben butona tıkladığımda bu sayfayı sekmeyle ayrılmış txt olarak kaydetmem lazım diyorsan butonun kod event'ı içerisine aşağıdaki kodu kullanabilirsin.


Private Sub CommandButton1_Click()
Dim dosyaadi As String
dosyaadi = InputBox("Dosya Adını Belirtiniz", "GATAB", "")
If dosyaadi = "" Then: Exit Sub

ActiveWorkbook.SaveAs Filename:= _
"C:\" & dosyaadi & ".txt", FileFormat:=xlText, _
CreateBackup:=False
End Sub