txt dosyasından veri çekme

[f_alkan]

txt dosyalarını excele aktarmak istiyorum.veriler arasında boşluklar var boşluktan sonra her veri satıra atılması gerekiyor.txt dosyaları fazla olduğu sadece 2 adet gönderilmiştir.yardımcı olan arkadaşlara tşk eder, hayırlı günler dilerim..

 

[m.akcan]

Veri / Metinden'i denediniz mi?

 

[Necdet]

Merhaba,

Text dosyasının bir kısmını excele çeviren kısımlarını yaptım. Geri kalanını siz örneği inceleyerek tamamlayınız.

Text Dosyalarının olduğu dizin "C:\TextOku" olarak varsayılmıştır. Siz bunu kodlarda değiştiriniz.

Sub DosyaGetir()
    
    Dim i       As Long, _
        Yol     As String, _
        Dosya   As String, _
        Veri    As String
    
    Yol = "C:\TextOku" & Application.PathSeparator
    
    Dosya = Dir(Yol & "*.txt", vbHidden)
    i = Cells(Rows.Count, "A").End(3).Row
    
    Application.UseSystemSeparators = False
    
    Do While Dosya <> ""
        
        Open Yol & Dosya For Input As #1
        
        Line Input #1, Veri
        Line Input #1, Veri
            
        While Not EOF(1)
            Line Input #1, Veri
            
            If IsDate(Mid(Veri, 2, 10)) = True Then
                i = i + 1
                Cells(i, "A") = Mid(Veri, 2, 10)
                Cells(i, "B") = Mid(Veri, 13, 10)
                Cells(i, "C") = Trim(Mid(Veri, 24, 8))
                Cells(i, "D") = Mid(Veri, 32, 7)
                Cells(i, "E") = Mid(Veri, 39, 6)
                Cells(i, "F") = Trim(Mid(Veri, 45, 14))
                Cells(i, "G") = Mid(Veri, 60, 16)
                Cells(i, "H") = Mid(Veri, 77, 21)
                Cells(i, "I") = Mid(Veri, 99, 21)
            End If
        Wend
        
        Close #1
        Dosya = Dir
    Loop
    Application.UseSystemSeparators = True
    
End Sub