xml-to-excel-via-url

[snb]

Code:

Public Sub Main()
    with Workbooks.OpenXML("C:\Temp\XML_Document1.xml")
       .sheets(1).Range("K3,L3,R3").Copy Tabelle1.Range("A1")
       .Close 0
    end with
End Sub

[PeterN]

Hallo Experten!

Vielen Dank für die Lösungen, die ich leider nicht nachvollziehen kann.

Gibt es eine Lösung in der ich in Excel die xml urls über eine Spalte aufrufe und die gewünschten Werte dann woanders hinschreibe?

[PeterN]

Hallo nochmal!

Mir würde auch nur der ERSTE Wert1 = jobkey erstmal reichen.

Also nur EIN Wert insgesamt pro abgefragter url, statt 10x3 Werte.

[schauan]

Hallöchen,

hast Du schon mal ausprobiert, hier
Range("K3,L3,R3").Copy
die beiden wegzulassen, die Du nicht brauchst?

z.B.
Range("K3").Copy

[Zwenn]

Hallo Peter,

welche Spalte in welcher Tabelle beherbergt denn Deine URLs und wo sollen die Werte hingeschrieben werden? Ob man nur den ersten oder alle drei holt und ob man das einmal oder bis zu zehn mal macht spielt absolut keine Rolle. Am besten wäre es, Du lädst eine Beispieldatei hoch, in der Du mit ein paar manuellen Einträgen andeutest, welche Werte wo hin sollen und markierst, in welcher Tabelle in welcher Spalte Deine URLs stehen. Es geht nur um den Ort, nicht um die URLs.

Viele Grüße,

Zwenn

[PeterN]

Moin André!

Ich habe nicht wirklich etwas ausprobiert, weil ich (wie meistens) die hier vorgebrachten Lösungsansätze mental nicht nachvollziehen und aus diesem Grunde technisch nicht umsetzen kann.

Gruss

Peter

[PeterN]

Moin Zwenn!

Anbei die Beispielliste.

Gruss

Peter

[Fennek]

Hallo,

da die ursprüngliche Beispiel-XML nur 3 Variablen enthält, hier ein Code zum Einlesen dieser Variante.Im Test wurde von der HD gelesen.

Gegeben: In Spalte A die URL (hier Pfad), das Makro füllte die Spalten aus:

Code:

Sub Read_XML()
'URL in Spalte A

With CreateObject("MSXML2.DOMDocument")

    For i = Cells(Rows.Count, "B").End(xlUp).Row + 1 To Cells(Rows.Count, "A").End(xlUp).Row
        .Load Cells(i, 1).Text
        sp = 2
        For e = 0 To .getElementsByTagName("jobkey").Length - 1
            Cells(i, sp).Offset(, 0) = .getElementsByTagName("jobkey")(e).Text
            Cells(i, sp).Offset(, 1) = .getElementsByTagName("jobtitle")(e).Text
            Cells(i, sp).Offset(, 2) = .getElementsByTagName("url")(e).Text
            sp = sp + 3
        Next e
    Next i
End With
End Sub

mfg

[Zwenn]

Hallo Peter,

in der angehängten Datei habe ich es mit 2 Tabellen gelöst. In eine kommen Deine URLs, in die andere werden die Daten nach Deiner Vorgabe eingetragen. Ich habe das mit 4 Dateien, mit jeweils 11 Datensätzen im Netzwerk getestet. Sollte also auch funktionieren, wenn die XML-Dateien im I-Net liegen.

Falls jemand nur den Code sehen will:

Steuerroutine:

Code:

Sub AlleXMLsAbrufen()

Dim urlTabelle As String
Dim ergebnisTabelle As String
Dim zeileURLs As String
Dim url As String
Dim aktuelleZeile As Long
Dim aktuelleSpalteEins As Integer
Dim anzahlDatensaetze As Long

 urlTabelle = "URLs"
 ergebnisTabelle = "Eingelesene Daten"
 anzahlDatensaetze = 10 'optional, wenn weggelassen, werden alle eingelesen
 zeileURLs = 2 'Startzeile der abzuarbeitenden URLs
 
 'Alle URLs in URL-Tabelle durchgehen
 Do Until Sheets(urlTabelle).Cells(zeileURLs, 1).Value = ""
   aktuelleZeile = 2
   If Sheets(ergebnisTabelle).Cells(Rows.Count, 1).End(xlUp).Row = 1 Then
     aktuelleSpalteEins = Sheets(ergebnisTabelle).UsedRange.Columns.Count
   Else
     aktuelleSpalteEins = Sheets(ergebnisTabelle).UsedRange.Columns.Count + 1
   End If
   url = Sheets(urlTabelle).Cells(zeileURLs, 1).Value
   Call EineXMLEinlesen(url, ergebnisTabelle, aktuelleZeile, aktuelleSpalteEins, anzahlDatensaetze)
   zeileURLs = zeileURLs + 1
 Loop
End Sub

XML einlesen:

Code:

Sub EineXMLEinlesen(url As String, tabelle As String, aktuelleZeile As Long, aktuelleSpalteEins As Integer, Optional anzahlDatensaetze As Long = 0)

'Variablen für den Dateizugriff und das DOM-Handling
Dim xmlDocument As Object
Dim knotenResult As Object
Dim knotenResultEinzel As Object
Dim knotenJobkey As Object
Dim knotenJobtitle As Object
Dim knotenURL As Object
Dim aktuellerDatensatz As Long
 
 'XML-Dokument instanzieren und XML-Dokument einlesen
 Set xmlDocument = CreateObject("MSXML2.DOMDocument")
 xmlDocument.Load url
 
 'Result-Tags einsammeln
 Set knotenResult = xmlDocument.getElementsByTagName("result")
 
 If Not knotenResult Is Nothing Then
   'Wenn vorhanden gewünschte Anzahl Result-Tags durchgehen
   For Each knotenResultEinzel In knotenResult
     'Datensätze hochzählen
     aktuellerDatensatz = aktuellerDatensatz + 1
     
     'Gewünschte Werte holen
     Set knotenJobkey = knotenResultEinzel.getElementsByTagName("jobkey")(0)
     Set knotenJobtitle = knotenResultEinzel.getElementsByTagName("jobtitle")(0)
     Set knotenURL = knotenResultEinzel.getElementsByTagName("url")(0)
     
     'Gewünschte Werte in die Tabelle eintragen, aus der das Makro gestartet wurde
     '(feste Tabelle kann natürlich vorangestellt werden)
     Sheets(tabelle).Cells(aktuelleZeile, aktuelleSpalteEins).Value = knotenJobkey.Text
     Sheets(tabelle).Cells(aktuelleZeile, aktuelleSpalteEins + 1).Value = knotenJobtitle.Text
     Sheets(tabelle).Cells(aktuelleZeile, aktuelleSpalteEins + 2).Value = knotenURL.Text
     
     'Nächste Zeile zum Beschreiben festlegen
     aktuelleZeile = aktuelleZeile + 1
     
     'Prüfen ob gewünschte Anzahl Datensätze eingelesen wurde, wenn
     'maximale Anzahl vorgegeben wurde und Einlesen ggf. beenden
     If aktuellerDatensatz = anzahlDatensaetze Then
       Exit For
     End If
   Next knotenResultEinzel
 End If
 
 'Aufräumen
 Set xmlDocument = Nothing
 Set knotenResult = Nothing
 Set knotenResultEinzel = Nothing
 Set knotenJobkey = Nothing
 Set knotenJobtitle = Nothing
 Set knotenURL = Nothing
End Sub

Viele Grüße,

Zwenn

[snb]

@Fen

Code:

Sub M_snb()
  sn = Sheet1.Columns(1).SpecialCells(2)

  With CreateObject("MSXML2.DOMDocument")
    For j = 1 To UBound(sn)
      .Load sn(j, 1)
      ReDim sp(UBound(sn), .getElementsByTagName("jobkey").Length - 1)
        
      For jj = 0 To UBound(sp, 2) Step 3
        sp(j, jj) = .getElementsByTagName("jobkey")(jj).Text
        sp(j, jj + 1) = .getElementsByTagName("jobtitle")(jj).Text
        sp(j, jj + 2) = .getElementsByTagName("url")(jj).Text
      Next
    Next
  End With
   
  Sheet1.Cells(1, 2).resize(UBound(sp), UBound(sp, 2) + 1) = sp
End Sub