AW: Text aus Files auslesen und in Zellen schreiben
18.07.2005 14:38:09
IngGi
Hallo Norbert,
laß' mich zunächst vorausschicken, dass ich mich mit XML-Dateien so gut wie überhaupt nicht auskenne. Allerdings weiß ich zumindest so viel, dass man XML-Dateien wie normale Textdateien behandeln kann. Und so sieht auch mein Lösungsweg aus. Ich bin dabei von einer ganzen Reihe von Annahmen ausgegangen, zu denen ich von dir evtl. noch nähere Angaben benötige, falls etwas so nicht zutrifft.
Was deine Datei Gesamt.xls angeht, so habe ich angenommen, dass die beiden Kombinationsfelder sich auf dem ersten (einzigen?) Tabellenblatt befinden und Standardnamen haben, nämlich ComboBox1 (D10) und ComboBox2 (D37).
Wenn ich dich richtig verstanden habe, dann befinden sich in den XML-Dateien jeweils Tags mit der Bezeichnung "und", also "<und>" als Anfangstag bzw. "</und>" als Endtag. Und dazwischen befindet sich entweder ein Wert ungleich 0 oder ein Text, der als Wert ausgewertet eben 0 ergibt. Ist der Wert gleich 0, also ein Text vorhanden, so soll dieser Text übernommen werden, andernfalls wird nichts übernommen.
Was die Struktur der XML-Datei angeht, so setze ich voraus, dass die Einträge zusammen mit Anfangs- und Endtag jeweils auf einer Zeile stehen, korrekt durch Zeilenendzeichen getrennt.
Das ergibt dann das folgende Makro als 1. Versuch:
Sub Daten_holen()
Dim Dat As Byte, str As String, nofile As Boolean
If ThisWorkbook.Sheets(1).ComboBox1 = "YES" Then
Dat = FreeFile
On Error GoTo Fehler
Open "E:\A.xml" For Input As #Dat
On Error GoTo 0
If nofile = False Then
Do
Line Input #Dat, str
Loop Until InStr(1, str, "</und>", vbTextCompare) > 0
str = Left(str, InStr(1, str, "</und>", vbTextCompare) - 1)
str = Right(str, Len(str) - InStr(1, str, ">", vbTextCompare))
If IsNumeric(str) = False Then ThisWorkbook.Sheets(1).Range("D56") = str
Close #Dat
Else
MsgBox ("Datei " & Chr$(34) & "E:\A.xlm" & Chr$(34) & " nicht vorhanden!")
nofile = False
End If
Dat = FreeFile
On Error GoTo Fehler
Open "E:\B.xml" For Input As #Dat
On Error GoTo 0
If nofile = False Then
Do
Line Input #Dat, str
Loop Until InStr(1, str, "</und>", vbTextCompare) > 0
str = Left(str, InStr(1, str, "</und>", vbTextCompare) - 1)
str = Right(str, Len(str) - InStr(1, str, ">", vbTextCompare))
If IsNumeric(str) = False Then ThisWorkbook.Sheets(1).Range("D57") = str
Close #Dat
Else
MsgBox ("Datei " & Chr$(34) & "E:\B.xlm" & Chr$(34) & " nicht vorhanden!")
nofile = False
End If
End If
If ThisWorkbook.Sheets(1).ComboBox1 = "YES" Then
Dat = FreeFile
On Error GoTo Fehler
Open "E:\C.xml" For Input As #Dat
On Error GoTo 0
If nofile = False Then
Do
Line Input #Dat, str
Loop Until InStr(1, str, "</und>", vbTextCompare) > 0
str = Left(str, InStr(1, str, "</und>", vbTextCompare) - 1)
str = Right(str, Len(str) - InStr(1, str, ">", vbTextCompare))
If IsNumeric(str) = False Then ThisWorkbook.Sheets(1).Range("D58") = str
Close #Dat
Else
MsgBox ("Datei " & Chr$(34) & "E:\A.xlm" & Chr$(34) & " nicht vorhanden!")
nofile = False
End If
End If
Fehler:
nofile = True
Resume Next
End Sub
Gruß Ingolf