thurbo
Goto Top

BATCH, VB, C++ or what else - Daten von txt in xls per Suchfunktion

Hallo Liebe Administrator-Gemeinde,

sitze an einer für mich unlösbaren Aufgabe fest. Wahrscheinlich hängt meine nächste Gehaltserhöhung davon ab. Ich bin auf euere Hilfe sehr angewiesen und suche einen experten der mir mit Rat und Tat zur Seite stehen kann......bitte enttäuscht mich nicht.

Nun zu meinem Problem.


Ich habe Datensätze die je Datensatz in einer Datei abgespeichert sind. Die Datensätze sind in jeder Datei ziemlich unsortiert. Daher scheidet der vordefinierte Zeilenextract schonmal aus.
Was ich brauche ist eine Art von "suchen, finden, in Excel importieren".

Habe folgende Suchwörter1:

name1
name3
strasse
ort
plz
anrede
geschlecht
geburtsdat

Hierbei ist es notwendig WENN dieses Wort gefunden, DANN die darunterliegende Zeile in EXCEL Spalte 1,2,3,4,5,6,7,8 importieren.

BEISPIEL1:

<entry>
<string>ort</string>
<string>Hillerse</string>
</entry>
<entry>
<string>plz</string>
<string>38543</string>
</entry>


Habe folgende Suchwörter2:
PHONE
MOBILE
EMAIL

Hierbei ist es notwendig WENN dieses Wort gefunden, DANN die vierte darunterliegende Zeile in EXCEL Spalte 9,10,11 importieren.

BEISPIEL2:

<string>art</string>
<kommunikationsArt>PHONE</kommunikationsArt>
</entry>
<entry>
<string>value</string>
<string>0190 - 666666</string>
</entry>
<entry>


Ich würde mich riesig freuen wenn dieses Problem irgendwie per Programierung gelöst wird. Ich werde mich selbstverständlich bei dem Helfer erkenntlich zeigen. ;)

Hab ich euer Interesse geweckt, lasst es mich wissen.

Vielen Dank.

Content-Key: 262778

Url: https://administrator.de/contentid/262778

Printed on: April 19, 2024 at 21:04 o'clock

Mitglied: 114757
114757 Feb 08, 2015 updated at 14:22:47 (UTC)
Goto Top
Moin,
das ist kein Problem, aber so wie deine Dateien aussehen sind das normale XML-Dateien, sehe ich das richtig ?
Wenn ja, diese lassen sich ganz gezielt auslesen, wenn man mal ein ganzes File sehen kann...
Aus einer XML-Datei mehrere Daten auslesen und in einer bestimmten Syntax in eine Excel-Datei speichern

Gruß jodel32
Mitglied: 114757
114757 Feb 08, 2015 at 16:40:38 (UTC)
Goto Top
Dim fso,objExcel,xmldoc,wb,ws,rngOut,file,node,XMLPATH

'Objekte erstellen  
Set fso = CreateObject("Scripting.Filesystemobject")  
Set xmldoc = CreateObject("msxml2.domdocument.6.0")  
Set objExcel = CreateObject("Excel.Application")  

'Pfad zu den XML-Dateien setzen (im Moment im gleichen Ordner wie das Script)  
XMLPATH = fso.GetParentFolderName(WScript.ScriptFullName)

'Neues Excel Workbook erstellen  
Set wb = objExcel.Workbooks.Add
Set ws = wb.Worksheets(1)
objExcel.DisplayAlerts = False
objExcel.ScreenUpdating = False
objExcel.Visible = True

'Überschriften setzen  
With ws.Range("A1:K1")  
	.Value = Array("Straße","Ort","PLZ","Geburtsdatum","Nachname","Vorname","Anrede","Geschlecht","Telefon","Mobil","E-Mail")  
	.Font.Bold = True
End With

'Start der Ausgabe im WS  
Set rngOut = ws.Range("A2")  

'Formate für alle Zellen auf Text setzen  
ws.Range("A:L").NumberFormat = "@"  

For Each file In fso.GetFolder(XMLPATH).Files
	If LCase(fso.GetExtensionName(file.Name)) = "xml" Then  
		
		xmldoc.validateOnParse = False
		xmldoc.load file.Path
		
		'gewünschte Nodes mit XPATH selektieren  
		Set node = xmldoc.selectSingleNode("//entry[string='strasse']")  
		If Not node Is Nothing Then
			rngOut.Value = node.childNodes.item(1).text
			Set node = Nothing
		End If
		Set node = xmldoc.selectSingleNode("//entry[string='ort']")  
		If Not node Is Nothing Then
			rngOut.Offset(0,1) = node.childNodes.item(1).text
			Set node = Nothing
		End If
		Set node = xmldoc.selectSingleNode("//entry[string='plz']")  
		If Not node Is Nothing Then
			rngOut.Offset(0,2) = node.childNodes.item(1).text
			Set node = Nothing
		End If
		Set node = xmldoc.selectSingleNode("//entry[string='geburtsdat']")  
		If Not node Is Nothing Then
			rngOut.Offset(0,3) = node.childNodes.item(1).text
			Set node = Nothing
		End If
		Set node = xmldoc.selectSingleNode("//entry[string='name1']")  
		If Not node Is Nothing Then
			rngOut.Offset(0,4) = node.childNodes.item(1).text
			Set node = Nothing
		End If
		Set node = xmldoc.selectSingleNode("//entry[string='name3']")  
		If Not node Is Nothing Then
			rngOut.Offset(0,5)= node.childNodes.item(1).text
			Set node = Nothing
		End If
		Set node = xmldoc.selectSingleNode("//entry[string='anrede']")  
		If Not node Is Nothing Then
			rngOut.Offset(0,6) = node.childNodes.item(1).text
			Set node = Nothing
		End If
		Set node = xmldoc.selectSingleNode("//entry[string='geschlecht']")  
		If Not node Is Nothing Then
			rngOut.Offset(0,7) = node.childNodes.item(1).text
			Set node = Nothing
		End If
		Set node = xmldoc.selectSingleNode("//entry[kommunikationsArt='PHONE']")  
		If Not node Is Nothing Then
			rngOut.Offset(0,8) = node.nextSibling.childNodes.item(1).text
			Set node = Nothing
		End If
		Set node = xmldoc.selectSingleNode("//entry[kommunikationsArt='MOBILE']")  
		If Not node Is Nothing Then
			rngOut.Offset(0,9) = node.nextSibling.childNodes.item(1).text
			Set node = Nothing
		End If
		Set node = xmldoc.selectSingleNode("//entry[kommunikationsArt='EMAIL']")  
		If Not node Is Nothing Then
			rngOut.Offset(0,10) = node.nextSibling.childNodes.item(1).text
			Set node = Nothing
		End If
		
		'Zeile um eins nach unten verschieben  
		Set rngOut = rngOut.Offset(1, 0)
	End If
Next
'Spaltenbreiten anpassen  
ws.Range("A:K").Columns.AutoFit  

objExcel.DisplayAlerts = True
objExcel.ScreenUpdating = True

'Objekte releasen  
Set xmldoc = Nothing
Set fso = Nothing
Set objExcel = Nothing
Gruß jodel32