Daten lesen (XML)
15.09.2022 12:04:44
stef26
ich habt mir gestern ein cooles Makro erstellen lassen, mit dem ich alle in der Spalte A aufgelisteten Excellisten öffne und Daten raus schreibe.
Danke nochmal dafür.
Ich hätte nun eine ähnliche Aufgabe, nur das es sich bei den Dateien um XML handelt.
Da bringt das Mako bei "Set objWorkbook = GetObject(PathName:=objCell.Text)" Klasse wird nicht unterstützt.
Public Sub ReadData()
Dim objCell As Range
Dim objWorkbook As Workbook
Dim objWorksheet As Worksheet
Application.EnableEvents = False
For Each objCell In Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
Application.StatusBar = " " & CStr(objCell.Row)
DoEvents
If Application.CountA(objCell.Resize(1, 27)) = 1 Then
If Dir$(PathName:=objCell.Text) vbNullString Then
Set objWorkbook = GetObject(PathName:=objCell.Text)
For Each objWorksheet In objWorkbook.Worksheets
With objWorksheet
Select Case .Name
Case "Tabelle1"
'erste Seite
objCell.Offset(0, 1).Value = .Range("A2").Value
objCell.Offset(0, 2).Value = .Range("B2").Value
objCell.Offset(0, 3).Value = .Range("C2").Value
objCell.Offset(0, 4).Value = .Range("D2").Value
objCell.Offset(0, 5).Value = .Range("E2").Value
objCell.Offset(0, 6).Value = .Range("F2").Value
objCell.Offset(0, 7).Value = .Range("G2").Value
objCell.Offset(0, 8).Value = .Range("H2").Value
objCell.Offset(0, 9).Value = .Range("I2").Value
objCell.Offset(0, 10).Value = .Range("J2").Value
objCell.Offset(0, 11).Value = .Range("K2").Value
objCell.Offset(0, 12).Value = .Range("L2").Value
'2te Seite
objCell.Offset(0, 13).Value = .Range("A3").Value
objCell.Offset(0, 14).Value = .Range("B3").Value
objCell.Offset(0, 15).Value = .Range("C3").Value
objCell.Offset(0, 16).Value = .Range("D3").Value
objCell.Offset(0, 17).Value = .Range("E3").Value
objCell.Offset(0, 18).Value = .Range("F3").Value
objCell.Offset(0, 19).Value = .Range("G3").Value
objCell.Offset(0, 20).Value = .Range("H3").Value
objCell.Offset(0, 21).Value = .Range("I3").Value
objCell.Offset(0, 22).Value = .Range("J3").Value
objCell.Offset(0, 23).Value = .Range("K3").Value
objCell.Offset(0, 24).Value = .Range("L3").Value
End Select
End With
Next
Call objWorkbook.Close(SaveChanges:=False)
Set objWorkbook = Nothing
End If
End If
Next
With Application
.StatusBar = False
.EnableEvents = True
End With
Call MsgBox("Fertig", vbInformation, "Information")
End Sub
Falls jemand weiß wie ich auch XML einlesen kann, wäre ich sehr dankbar...
Liebe Grüße
Stefan