Opgelost Txt bestand inlezen in Excel

[PeterBijns]

Ja zeker ook bedankt aan snb welke een geweldige korte code heeft gemaakt die het uitstekend doet.
Hulde..!!!
Groet, Peter

 

[cow18]

die code is een klassieker/oldtimer die al een tijdje meegaat, weet ik veel, +10 jaar, maar dat doet er natuurlijk niets van af ...

 

[snb]

Dit zou ik ervan maken:

Sub M_snb()
  With Application.FileDialog(3)
    .InitialFileName = Application.DefaultFilePath & "*.txt"
    If .Show Then sn = Split(CreateObject("scripting.filesystemobject").opentextfile(.SelectedItems(1)).readall, "<wpt")
  End With
  
  ReDim sp(UBound(sn), 20)

  For j = 1 To UBound(sn)
    st = Split(sn(j), Chr(34))
    sp(j - 1, 0) = st(1)
    sp(j - 1, 1) = st(3)
    st = Filter(Filter(Filter(Filter(Split(Split(Split(sn(j), "<name")(1), "</gpxx:W")(0), vbCrLf), "</"), "<cmt", 0), "Disp", 0), ":A", 0)

    For jj = 0 To UBound(st)
      sp(j - 1, jj + 2) = Split(Split(st(jj), ">")(1), "<")(0)
    Next
  Next

  Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(sp), UBound(sp, 2)) = sp
End Sub

 

[PeterBijns]

Wederom dank snb, voor je code maar als ik hem draai dan kan ik door de mappen bladeren maar zie ik geen tekst bestanden. Ik het openings venster zie ik dit staan excel*.txt.
Als ik excel weghaal komen de txt bestanden pas in het grote keuze venster te zien. De macro werkt perfect alleen dat laatste is ietwat lastig, is dat ook zo ta maken dat ik gelijk txt bestanden kan zien?

Groet, Peter

 

[edmoor]

Wijzig dit:

.InitialFileName = Application.DefaultFilePath & "*.txt"

Eens in dit:

.InitialFileName = Application.DefaultFilePath & "\*.txt"

 

[PeterBijns]

Edmoor, heel erg bedankt voor je oplossing van mijn probleempje, en zo geweldig snel echt super van je je maakt me erg blij.
Groet, Peter

 

[snb]

Ik vind de benadering van Ahulpje ook interessant.
Hij kan alleen wat robuuster.

Sub M_snb()
    With CreateObject("MSXML2.DOMDocument")
        .Load "J:\download\Drachten met url.txt"
        ReDim sp(.SelectNodes("//wpt").Length, 20)
        
        For Each it In .SelectNodes("//wpt")
          sp(n, 0) = it.Attributes(1).Text
          sp(n, 1) = it.Attributes(0).Text

          With it.LastChild.ChildNodes(0).ChildNodes(1)
            For jj = 0 To .ChildNodes.Length - 1
              If jj < 3 Then sp(n, jj + 2) = it.ChildNodes(Choose(jj + 1, 2, 3, 5 - (it.ChildNodes.Length = 8))).Text
              sp(n, jj + 5) = .ChildNodes(jj).Text
            Next
          End With

          With it.LastChild.ChildNodes(0)
            If .ChildNodes.Length = 3 Then sp(n, 10) = .LastChild.Text
          End With
          n = n + 1
        Next
    End With

    Cells(1).Resize(UBound(sp) + 1, UBound(sp, 2) + 1) = sp
End Sub

 

[edmoor]

Mooi inderdaad.
Voor TS dus zo:

Sub M_snb()
    With Application.FileDialog(3)
      .InitialFileName = Application.DefaultFilePath & "\*.txt"
      If .Show Then
          sn = .SelectedItems(1)
          With CreateObject("MSXML2.DOMDocument")
              .Load sn
              ReDim sp(.SelectNodes("//wpt").Length, 20)
         
              For Each it In .SelectNodes("//wpt")
                  sp(n, 0) = it.Attributes(1).Text
                  sp(n, 1) = it.Attributes(0).Text
  
                  With it.LastChild.ChildNodes(0).ChildNodes(1)
                        For jj = 0 To .ChildNodes.Length - 1
                            If jj < 3 Then sp(n, jj + 2) = it.ChildNodes(Choose(jj + 1, 2, 3, 5 - (it.ChildNodes.Length = 8))).Text
                            sp(n, jj + 5) = .ChildNodes(jj).Text
                        Next
                  End With
  
                  With it.LastChild.ChildNodes(0)
                      If .ChildNodes.Length = 3 Then sp(n, 10) = .LastChild.Text
                  End With
                  n = n + 1
                Next
            End With
      End If
      Cells(1).Resize(UBound(sp) + 1, UBound(sp, 2) + 1) = sp
    End With
End Sub

 

[alphamax]

Met XPath onderdeel van de (VBA?) XML-bibliotheken.
Met een klein beetje studie kan je zelf de code aanpassen.
Kijk maar eens naar de variabele avNode

Private Sub CommandButton1_Click()

    On Error Resume Next

    avNode = Array("@lon", "@lat", "name", "desc", "sym", ".//gpxx:StravNodetAoNoderess", "", ".//gpxx:PostalCode", ".//gpxx:City", ".//gpxx:State", ".//gpxx:Country", ".//gpxx:PhoneNumber", "link/@href")

    With Application.FileDialog(3)
        .InitialFileName = Application.DefaultFilePath & "\*.txt"
        If .Show Then
            vPath = .SelectedItems(1)

            Range("A2").CurrentRegion.Offset(1, 0).ClearContents

            With CreateObject("MSXML2.DOMDocument")
                .Load vPath
                For Each oNode In .SelectNodes("//wpt")
                    j = j + 1
                    For i = 0 To UBound(avNode)
                        Range("A2").Offset(j, i).Value = oNode.SelectSingleNode(avNode(i)).Text
                    Next
                Next
            End With

            Application.Goto Range("A2")

        End If

    End With

End Sub