.txt dosyasından veri alma

[unfors]

Dim fname, yol As String, dosya As String
Dim con As Object, rs As Object
fname = Application.GetOpenFilename("Text Dosyaları,*.txt")
yol = Mid(fname, 1, InStrRev(fname, "\", -1, 1))
dosya = Replace(fname, yol, "")
Set con = CreateObject("adodb.connection")
con.Open "provider=microsoft.jet.oledb.4.0;data source=" & yol & ";Extended Properties =""text;HDR=Yes;FMT=Delimited"""
Set rs = CreateObject("adodb.recordset")
rs.Open "select * from " & dosya, con, 1, 1
If rs.RecordCount > 0 Then
Range("a1").CopyFromRecordset rs
End If
rs.Close: Set rs = Nothing
con.Close: Set con = Nothing
yol = vbNullString: dosya = vbNullString: fname = vbNullString

Kod ile txt dosyasından veri alıyorum. İstediğim sadece txt dosyasının son satırındaki veriyi alabilmek.

 

[Necdet]

Merhaba,

Seçenek olsun, kendinize uyarlayınız.

 Sub SonSatir()
 
    Dim Dosya   As String, _
        Satir   As String
    
    On Error GoTo Son
    
    Dosya = "\abc.txt"
    
    Open Dosya For Input As 1
    
    Do While Not EOF(1)
        Input #1, Satir
    Loop
    
    Close #1
    
    MsgBox "Son Kayıt : " & Satir
    Exit Sub
Son:
    MsgBox "Dosyayı Bulamadım..."
     
End Sub

 

[unfors]

Teşekkür ederim. ADO ile mümkün değil midir yapmak?

 

[Necdet]

Merhaba,

Sizin kodlarınızda biraz değişiklik yaptım, deneyiniz.

Sub TextVeriAl()

    Dim fname, yol As String, dosya As String
    Dim con As Object, rs As Object
    Dim SonKayit As String
        
    fname = Application.GetOpenFilename("Text Dosyaları,*.txt")
    yol = Mid(fname, 1, InStrRev(fname, "\", -1, 1))
    dosya = Replace(fname, yol, "")
    Set con = CreateObject("adodb.connection")
    con.Open "provider=microsoft.jet.oledb.4.0;data source=" & yol & ";Extended Properties =""text;HDR=Yes;FMT=Delimited"""
    Set rs = CreateObject("adodb.recordset")
    rs.Open "select * from " & dosya, con, 1, 1
    
    Do While Not rs.EOF
        SonKayit = rs.Fields.Item(0)
        rs.MoveNext
    Loop
    
        MsgBox "Son Veri : " & SonKayit
    
'    If rs.RecordCount > 0 Then
'        Range("a1").CopyFromRecordset rs
'    End If
    
    rs.Close: Set rs = Nothing
    con.Close: Set con = Nothing
    yol = vbNullString: dosya = vbNullString: fname = vbNullString
    
End Sub