Makro ile TXT veri alma

[mukoli]

Merhaba hocalarım ekteki txt dosyaları paylaşımdaki klasörlerde oluşuyor . 2 firmanında ayrı klasörde txt dosyalar var yapmak istediğim makro ile 10. satırdaki bilgileri excele çekmek istiyorum. hangi firmanın bilgisi ise b hücresine yazarsa cok iyi olur . Ben yapmaya çalıştım fakat direk txt içerigini alan kodlar var oyuzden yardımızı rica ediyorum.

 

[Haluk]

Dosyanız...

.

 

[mukoli]

Çok sağolun haluk hocam deneyince bilgi vericem tekrardan teşekkürler

 

[mukoli]

Hocam iyi gecdler şimdi deneme fırsatım oldu . Tam istediğim gibi olmuş çok teşekkürler ama birşeyi atlamışım klasörlerin içinde başka txt var . Sadece d sütununda yazan txt dosya adlarını arayıp bilgileri getirmesi cok iyi olur eğer bu olursa konu tamamen çözülmüş olucaktır . Tekrardan teşekkürler

 

[Haluk]

D sütunundaki dosya isimlerini kullanmadan, eğer klasörlerdeki aradığınız text dosyalarının adı "Mesaj.txt" ile bitiyorsa;

Sub Test()
'   Haluk - 17/04/2022
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set myFolder = FSO.GetFolder(ThisWorkbook.Path)
  
    Range("A1:B1") = Split("Data Firma")
    i = 1
    For Each xFolder In myFolder.SubFolders
        i = i + 1
        For Each xFile In xFolder.Files
            If Right(xFile.Name, 9) = "Mesaj.txt" Then
                MyFile = xFolder.Path & "\" & xFile.Name
                Open MyFile For Input As #1
                    fileData = Input(LOF(1), #1)
                    Range("A" & i) = Replace(Split(fileData, vbCrLf)(9), Chr(34), "")
                    Range("B" & i) = xFolder.Name
                Close #1
            End If
        Next
    Next
End Sub

.

 

[mukoli]

Çok teşekkürler hocam emeginize sağlık bu şekilde daha iyi oldu.

 

[mukoli]

Haluk hocam tekrardan k.bakmayın sistem biraz değişti . Txt dosyaları bir klasörde olucak o şekilde düzenleyebilirmiyiz kodu şimdiki kod alt klasördeyse txt o şekilde çalışıyor . dosya adını b sütununa yazdırmamız yeterli olur . Tekrardan k.bakmayın

 

[Haluk]

Sub Test2()
'   Haluk - 17/04/2022
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set myFolder = FSO.GetFolder(ThisWorkbook.Path)
    
    Range("A1:B1") = Split("Data Firma")
    i = 1
    For Each xFile In myFolder.Files
        If Right(xFile.Name, 9) = "Mesaj.txt" Then
            i = i + 1
            Open xFile For Input As #1
                fileData = Input(LOF(1), #1)
                Range("A" & i) = Replace(Split(fileData, vbCrLf)(9), Chr(34), "")
                Range("B" & i) = Split(Split(xFile.Name, "_")(0), "-")(1)
            Close #1
        End If
    Next
End Sub

.

 

[mukoli]

Çok sağolun hocam
Range("B" & i) = Split(Split(xFile.Name, "_")(0), "-")(1)
Bu satırda hata verdi kod ama

 

[Haluk]

Verdiğiniz örnek dosyaların adı;

"CS-AKTUEL_CS-AKTUEL-K1_Mesaj.txt"

şeklindeydi..... Bunlarda hata vermez.

.

 

[mukoli]

Kontrol ediyorum tekrardan

 

[mukoli]

Evet hocam 1 tane dosyanın adında sıkıntı varmış ondan dolayı teşekkür ederim