Dizin İçindeki Text Dosyalardan Veri Almak

[tetrax]

Merhaba sevgili arkadaşlar.

bir dizin içinde pekçok text dosyam var.

makroya kayıt yaparak bu dizin içindeki bir text dosyasından istediğim şekilde verileri aldım.

ancak bu makro çalıştırıldığında "c:\text" dizini içersinde ne kadar text dosyası varsa tümünden aynı şekilde veri alsın istiyorum.
aldığı verileri de dosya ismiyle aynı isimde bir sheet oluşturarak oraya kaydetsin.

forumda benzer örnekler gördüm ama, bir türlü beceremedim.
yardımcı olabilir misiniz ?
şimdiden çok teşekkür ederim.


tek bir text dosyası için kaydettiğim makro aşağıda :

=========================================

Sub Makro1()
Workbooks.OpenText Filename:="C:\TEXT\ISTANBUL_06.09.2007.txt", Origin _
:=857, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 2), _
Array(10, 5), Array(16, 1), Array(23, 2), Array(34, 2), Array(40, 2), Array(45, 9), Array( _
46, 2), Array(52, 9)), TrailingMinusNumbers:=True
End Sub

=========================================

 

[Levent Menteşoğlu]

Bu text dosyalarından birkaç tane örnek eklermisiniz.

 

[Zeki Gürsoy]

Dosyalar virgül ayraçlı ise sorun olmaz sanırım.

Sub Veri_Al()
Dim cn     As Object
Dim rs     As Object
Dim myPath As String

myPath = "C:\text\"
d = Dir(myPath)

    Do While d <> ""
    
        Set cn = CreateObject("ADODB.Connection")
    
        cn.Open _
        "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & myPath & _
        ";Extended Properties=""text;HDR=No;FMT=Delimited"""
    
        Set rs = cn.Execute("SELECT * FROM " & d)
    
        Worksheets.Add , Sheets.Count
        Sheets(Sheets.Count).Name = d
        Sheets(Sheets.Count).[a1].CopyFromRecordset rs
        
        rs.Close
        cn.Close
    Loop
    
    Set rs = Nothing
    Set cn = Nothing
End Sub

 

[tetrax]

text dosyalarından birkaç örnek ve excel dosyasını gönderiyorum.
excel dosyasına konuyu açıklayıcı bilgi yazdım.
ilginiz için çok teşekkür ederim.

 

[Haluk]

Ekli dosyaya bir göz atarsınız ....

 

[Zeki Gürsoy]

Haluk bey'in örneğinde gözden kaçan şu ilaveyi yapmak gerekiyor.

Open [B]MyPath &[/B] MyFile For Input As #1

 

[Haluk]

Evet doğru, gözümden kaçmış ...

Dosya yukarıdaki mesaj başlığı altında yenilendi.

 

[tetrax]

Değerli ustalarım Sayın Haluk ve Sayın Anemos ilginiz için çok teşekkür ederim.

teşekkür cevabım geciktiği için kusura bakmayın.

Sayın Haluk'un kodları ile ve Anemos'un eklentisine rağmen
runtime 53
file not found
hatası alıyordum ve bunu çözmekle meşguldüm.

sonunda becerdim, eksik olan "\" işaretini yerine koydum ve bir hevesle "bakın ben ne buldum" diye yazmak için forumu açtığımda bir de ne göreyim, siz bana fırsat vermeden çoktan gerekli düzenlemeyi yapmışsınız.

Benim için çok faydalı oldu bu konu.
Umarım izleyen arkadaşlarda yararlanmışlardır.

Tekrar teşekkür ediyorum.
Elinize, emeğinize, yardımlaşma ruhunuza ve aklınıza sağlık....