TXT dosyasının son 10 satırını kopyalamak

[Recep İpek]

Merhaba,

Mevcut bir TXT dosyasının son 10 satırını başka bir klasöre TXT olarak nasıl kopyalayabiliriz?

Aşağıdaki örnekleri buldum.Fakat bir türlü birleştiremedim. :|

Sub DataOku()
Dim Data As String
Open "C:Deneme\DENEME.txt" For Input As #1
Do While Not EOF(1)
Line Input #1, Data
MsgBox Data
Loop
Close #1
End Sub

Sub TXTDosyaKopyalama()
FileCopy "C:\Deneme\DENEME.txt", "C:\Dosyalarım\DENEME.txt"
End Sub

 

[halit3]

bunu önce list kutusuna aktar oradanda ensondan 10 tanesini başka txt dosyasına aktar

 

[halit3]

aşağıdaki formülü denermisiniz


'burası okumak için

List1.Clear
Open "Ceneme\DENEME.txt" For Input As #1
Do While Not EOF(1)
Line Input #1, a
List1.AddItem a
Loop
Close

'burasıda yazmak için
sıra = List1.ListCount
Open "Ceneme\DENEME1.txt" For Output As #1
For i = sıra-10 To sıra
Print #1, List1.List(i - 1)
Next
Close #1

 

[Recep İpek]

Peki TXT dosyasının satır sayısını nasıl öğrenebilirmiyiz?

 

[halit3]

yukarıdaki
list kutusunda var
aşağıdaki gibi

'burası kaç adet olduğunu gösteriyor
sıra = List1.ListCount

 

[hamitcan]

Recep bey, ben sonuca çok yaklaştım. Son satır nosunu öğrenmek isterseniz...

Sub dosya_sonunda_tüm_satır()
Dim ds, a, son
Dim Data As String

Set ds = CreateObject("Scripting.FileSystemObject")
Set a = ds.OpenTextFile(yol)
Do While a.AtEndOfStream <> True
son = a.ReadLine 'Dosya Sonundaki tüm satırı verir.
s = s + 1
Loop
MsgBox s
a.Close
end sub

 

[hamitcan]

Const yol = "C:\deneme\ddd.txt"
Const yol2 = "C:\deneme\ddd2.txt"
Sub dosya_sonunda_tüm_satır()
Dim ds, a, son
Dim Data As String

Set ds = CreateObject("Scripting.FileSystemObject")
Set a = ds.OpenTextFile(yol)
Do While a.AtEndOfStream <> True
son = a.ReadLine 'Dosya Sonundaki tüm satırı verir.
s = s + 1
Loop
MsgBox s
a.Close

Open yol For Input As #1
Do While Not EOF(1)
    Line Input #1, Data
        c = c + 1
        If c >= s - 9 Then
        Set MyFile = ds.CreateTextFile(yol2)
            [B][color=red]MyFile.WriteLine Data[/B][/color] 'Bu satırda takıldım. Burada tek bir satırı yazdırabiliyorum.
            MyFile.Close
        End If
Loop
Close #1
End Sub

 

[Recep İpek]

Bende biraz çözüme ulaştım.

Sub Aktar()
Dim veri1, veri2, i, j As Variant
Open "C:Deneme\DENEME.txt" For Input As #1
Do While Not EOF(1)
Line Input #1, veri1
i = i + 1  [COLOR=blue]'Son satırı bulma[/COLOR]
Loop
Close #1
 
MsgBox i
 
Open "C:\Deneme\DENEME.txt" For Input As #1
    Open "C:\Deneme\DENEME1.txt" For Output As #2
 
        For j = i To i - 4 Step -1
 
            Line Input #1, veri2
           [COLOR=green] 'Get #1, j, veri2[/COLOR]
            Print #2, veri2
 
        Next j
    Close #1
Close #2
MsgBox "Bitti", vbInformation, "Bilgi"
End Sub

Burada Get fonksiyonu tam bana göre.Fakat çalıştıramadım.
Txt dosyasından verilen satır numarasına göre bilgiyi alabilirsem süper olacak.....

 

[ozgretmen]

Sayın halit3 ün vermiş olduğu kodları denedim ve oldu.Gayet güzel çalışıyor.

 

[Zeki Gürsoy]

Burada Get fonksiyonu tam bana göre.Fakat çalıştıramadım.
Txt dosyasından verilen satır numarasına göre bilgiyi alabilirsem süper olacak.....

"Get" ve "Put" komutunu Random ve Binary dosyalrda kullanabilirsiniz.
İstediğiniz "sıra erişimli" denilen metot ile dosyadan okumak olduğu için tamamını okuyup indexledikten sonra istenilen kayıtları alabiliyoruz.

 

[Recep İpek]

Sayın halit3 ün vermiş olduğu kodları denedim ve oldu.Gayet güzel çalışıyor.

Evet gayet güzel olmuş.Sanırım bu şekilde kullanacağız.

İlgilenen arkadaşlara teşekkürler.

 

[Recep İpek]

En sonunda aradığım çözümü buldum.

Sub Aktar()
Dim veri1, veri2 As String
Dim i, j As Integer
 
Open "C:\Deneme\DENEME.txt" For Input As #1
Do While Not EOF(1)
     Line Input #1, veri1
     i = i + 1  [COLOR=#0000ff]'Son satırı bulma[/COLOR]
Loop
Close #1
 
Open "C:\Deneme\DENEME.txt" For Input As #1
    Open "C:\Deneme\DENEME1.txt" For Output As #2
 
        For j = 1 To i
            Line Input #1, veri2
                If j > i - 10 Then
                    Print #2, veri2
                End If
        Next j
    Close #1
Close #2
 
MsgBox "Bitti", vbInformation, "Bilgi"
End Sub

 

[halit3]

arkadaşlar vb de ve excell makrolarında ayrı ayrı yapılmış bir örnek burada
list kutusunu kullanma sebebimiz son 10 satırın boş yada dolu olması ili ilgilidir.


'vb de örnek
Private Sub Command1_Click()
List1.Clear
Open "C:\deneme.txt" For Input As #1
Do While Not EOF(1)
Line Input #1, a
List1.AddItem a
Loop
Close

If List1.ListCount < 10 Then
For i = List1.ListCount To 9
List1.AddItem ""
Next
End If

Open "C:\deneme1.txt" For Output As #1
For i = List1.ListCount - 10 To List1.ListCount - 1
Print #1, List1.List(i)
Next
Close #1
List1.Clear
End Sub

'excelde örnek
Private Sub CommandButton1_Click()
ListBox1.Clear
Open "C:\deneme.txt" For Input As #1
Do While Not EOF(1)
Line Input #1, a
ListBox1.AddItem a
Loop
Close

If ListBox1.ListCount < 10 Then
For i = ListBox1.ListCount To 9
ListBox1.AddItem ""
Next
End If

Open "C:\deneme1.txt" For Output As #1
For i = ListBox1.ListCount - 10 To ListBox1.ListCount - 1
Print #1, ListBox1.List(i)
Next
Close #1
ListBox1.Clear
End Sub

 

[halit3]

yanlız recep beyinkide cok güzel olmuş