Kapalı txt dosyasından veri alma

[tamer42]

Merhabalar,

Kapalı durumda bulunan bir txt dosyasından excel' e belli verileri aktarmak istiyorum.

txt dosyasında satırları okuyacak ve <name> ............... </name> aralığında yazan verileri getirecek

If kString Like "*</name>*" Then

  a = Len(kString)
                b = WorksheetFunction.Find("</", kString, 1)
           
           
        nString = Left(kString, b - 1)


end If

bu şekilde aradan veriler almak istiyorum.

bununla ilgili örnek verebilir misiniz.

iyi çalışmalar.

 

[Mehmet Şahin]

Merhaba,
kodları bir modüle kopyalayıp, deneyiniz. iyi çalışmalar.

Sub import()
Dim sh As Worksheet
Dim dosya As Variant
Dim satir As String
Set sh = Sheets("Sayfa1")
ChDir ThisWorkbook.Path

Dim deger As String
sn = sh.Cells(65536, 1).End(xlUp).Row + 1
Dim FSO As Object
dosya = Application.GetOpenFilename("Metin dosyası (*.txt),*.txt", , "Hedef Dosyayı Seçin")
If dosya = False Then Exit Sub
sh.Range("a2:a" & sn + 1).ClearContents
st = 2
Application.ScreenUpdating = False
Open dosya For Input Access Read As #1
   While Not EOF(1)
      Line Input #1, satir
        satir = Replace(satir, "<name>", "", 1, -1, vbTextCompare)
        satir = Replace(satir, "</name>", "", 1, -1, vbTextCompare)
        sh.Cells(st, "a") = satir
        st = st + 1
   Wend
Close #1
Application.ScreenUpdating = True
MsgBox "Veri Aktarımı Tamamlanmıştır!"
Set sh = Nothing
End Sub

 

[baydeniro]

Teşekkürler

 

[Mehmet Şahin]

Teşekkürler

Soruyu soran arkadaşın sorunu çözüldü mü bilemiyorum ama, işinize yaradıysa sevindim. İyi çalışmalar.

 

[poseidon26]

çok teşekkürler ediyorum. Yana yakıla bunu arıyordum. 10 numara paylaşım olmuş. ilk satırı almadan kalanı almasını nasıl sağlarız peki? ikinci satırdan başlasın almaya mesela?
Kolay gelsin.

Merhaba,
kodları bir modüle kopyalayıp, deneyiniz. iyi çalışmalar.

Sub import()
Dim sh As Worksheet
Dim dosya As Variant
Dim satir As String
Set sh = Sheets("Sayfa1")
ChDir ThisWorkbook.Path

Dim deger As String
sn = sh.Cells(65536, 1).End(xlUp).Row + 1
Dim FSO As Object
dosya = Application.GetOpenFilename("Metin dosyası (*.txt),*.txt", , "Hedef Dosyayı Seçin")
If dosya = False Then Exit Sub
sh.Range("a2:a" & sn + 1).ClearContents
st = 2
Application.ScreenUpdating = False
Open dosya For Input Access Read As #1
   While Not EOF(1)
      Line Input #1, satir
        satir = Replace(satir, "<name>", "", 1, -1, vbTextCompare)
        satir = Replace(satir, "</name>", "", 1, -1, vbTextCompare)
        sh.Cells(st, "a") = satir
        st = st + 1
   Wend
Close #1
Application.ScreenUpdating = True
MsgBox "Veri Aktarımı Tamamlanmıştır!"
Set sh = Nothing
End Sub