Herstellung eines Telefonbuchs für die Fritz!Box

realName;home;work;mobile;fax_work;
Herbert Mustermann;099929929;024334554345;0151993885;02235235;
Sepp Meier;0558452;;;;
Sabine Mustermann;1235465;11111;44444;;

CSVFILE = "C:\input.csv"  
XMLPATH = "C:\phonebook.xml"  
strXMLStart = "<?xml version=""1.0"" encoding=""iso-8859-1""?><phonebooks><phonebook>"  
strXMLEnd = "</phonebook></phonebooks>"  
Const ForReading = 1
Const ForWriting = 2
Set objFSO = CreateObject("Scripting.FileSystemObject")  

uniqueID = 0
allContacts = ""  
Set objCSV = objFSO.OpenTextFile(CSVFILE, ForReading)
header = objCSV.ReadLine
Do Until objCSV.AtEndOfStream
    strNextLine = objCSV.Readline
    If strNextLine <> "" Then  
    	arrMapping = Split(strNextLine , ";")  
  		realName = Trim(arrMapping(0))
  		home = Trim(arrMapping(1))
  		work = Trim(arrMapping(2))
  		mobile = Trim(arrMapping(3))
  		fax_work = Trim(arrMapping(4))
  		contactItemNumbers = ""  
  		numberCounter = 0
  		If home <> "" Then  
  			contactItemNumbers = "<number type=""home"" prio=""0"" id=""" & numberCounter & """>" & home & "</number>"  
  			numberCounter = numberCounter + 1
  		End If
  		If work <> "" Then  
  			contactItemNumbers = contactItemNumbers & "<number type=""work"" prio=""0"" id=""" & numberCounter & """>" & work & "</number>"  
  			numberCounter = numberCounter + 1
  		End If
  		If mobile <> "" Then  
  			contactItemNumbers = contactItemNumbers & "<number type=""mobile"" prio=""0"" id=""" & numberCounter & """>" & mobile & "</number>"  
  			numberCounter = numberCounter + 1
  		End If
  		If fax_work <> "" Then  
  			contactItemNumbers = contactItemNumbers & "<number type=""fax_work"" prio=""0"" id=""" & numberCounter & """>" & fax_work & "</number>"  
  			numberCounter = numberCounter + 1
  		End If
  		ticks = DateDiff("s","1/1/1970 12:00:00 AM",Now)  
  		contactItemPart1 = "<contact><category>0</category><person><realName>" & realName & "</realName></person><telephony nid=""" & numberCounter & """>"  
  		contactItemPart2 = contactItemNumbers
  		contactItemPart3 = "</telephony><services /><setup /><mod_time>" & ticks & "</mod_time><uniqueid>" & uniqueID & "</uniqueid></contact>"  
  		allContacts = allContacts & contactItemPart1 & contactItemPart2 & contactItemPart3
  		uniqueID = uniqueID + 1 
    End if
Loop
objCSV.Close
Set objXMLFile = objFSO.OpenTextFile(XMLPATH,ForWriting, True)
objXMLFile.Write strXMLStart & allContacts & strXMLEnd
objXMLFile.Close
WScript.Echo "Fertig"  

Set objXMLFile = objFSO.OpenTextFile(XMLPATH,ForWriting,True)

Lieschen Müller;mobile;0172333444555;1;5;
Klaus Bärbel;home;02345654321;;6;
Fa. GWS Röhrig;work;02345110112;;;

Option Explicit

' Dateinamen  
Const sCSV_in = "test.csv"  
Const sXML_out = "test.xml"  

' Variablendeklarationen  
Dim oXmlDoc, oPhonebookNode, oContactNode, oCategoryNode, oPersonNode, _
  oTelephonyNode, oServicesNode, oSetupNode, oModtimeNode, oUniqueIDNode, _
  oRealNameNode, oNumberNode, oRingToneNode, oXsltDoc
Dim oFSO, oFile, i, aLine, sLine, sName, sType, sNumber, sCategory, sQuickdial

Set oFSO = CreateObject("Scripting.FileSystemObject")  
Set oFile = oFSO.OpenTextFile(sCSV_in) 'CSV Filestream  
CreateObject("WScript.Shell").CurrentDirectory = oFSO.GetParentFolderName(WScript.ScriptFullName) 'Arebeitsverzeichnis = Scriptverzeichnis  

Set oXmlDoc = CreateObject("Msxml2.DOMDocument.6.0") 'XML Dokument erzeugen  
oXmlDoc.async = False
oXmlDoc.loadXML "<?xml version=""1.0"" encoding=""windows-1252""?><phonebooks />" 'XML Deklaration und Rootelement  
Set oPhonebookNode = oXmlDoc.createNode(1, "phonebook", "") 'phonebook Element hinzu  
oXmlDoc.documentElement.appendChild oPhonebookNode

i = 0 'wird bei jedem Schleifendurchlauf inkrementiert und für "uniqueid" eingesetzt  

While Not oFile.AtEndOfStream 'solange das Dateiende nicht erreicht ist  
  i = i + 1 'i inkrementieren  
  sLine = oFile.ReadLine '(nächste) Zeile lesen  
  If sLine <> "" Then  
    aLine = Split(sLine, ";") 'an den Semikola in ein Array splitten  
    If UBound(aLine) <> 5 Then
      WScript.Echo "Zeile """ & sLine & """ hat die falsche Anzahl Elemente"  
    Else
      sName = Trim(aLine(0)) 'Name  
      sType = Trim(aLine(1)) 'Typ (home, work, mobile)  
      sNumber = Trim(aLine(2)) 'Telefonnummer  
      sCategory = Trim(aLine(3)) 'VIP  
      sQuickdial = Trim(aLine(4)) 'Kurzwahl  
      'Einzelne Knoten und Kindknoten für jeden Kontakt erstellen  
      Set oContactNode = oXmlDoc.createNode(1, "contact", "")  
      oPhonebookNode.appendChild oContactNode
      Set oCategoryNode = oXmlDoc.createNode(1, "category", "")  
      oContactNode.appendChild oCategoryNode
      Set oPersonNode = oXmlDoc.createNode(1, "person", "")  
      oContactNode.appendChild oPersonNode
      Set oTelephonyNode = oXmlDoc.createNode(1, "telephony", "")  
      oTelephonyNode.setAttribute "nid", "1"  
      oContactNode.appendChild oTelephonyNode
      Set oServicesNode = oXmlDoc.createNode(1, "services", "")  
      oContactNode.appendChild oServicesNode
      Set oSetupNode = oXmlDoc.createNode(1, "setup", "")  
      oContactNode.appendChild oSetupNode
      Set oModtimeNode = oXmlDoc.createNode(1, "mod_time", "")  
      oContactNode.appendChild oModtimeNode
      Set oUniqueIDNode = oXmlDoc.createNode(1, "uniqueid", "")  
      oContactNode.appendChild oUniqueIDNode
      Set oRingToneNode = oXmlDoc.createNode(1, "ringTone", "")  
      oSetupNode.appendChild oRingToneNode
      oModTimeNode.text = CStr(DateDiff("s", DateSerial(1970, 1, 1) + TimeSerial(12, 0, 0), Now)) 'UNC Timestamp  
      oUniqueIDNode.text = CStr(i)
      Set oRealNameNode = oXmlDoc.createNode(1, "realName", "")  
      oPersonNode.appendChild oRealNameNode
      oPersonNode.text = sName
      Set oNumberNode = oXmlDoc.createNode(1, "number", "")  
      oTelephonyNode.appendChild oNumberNode
      oNumberNode.setAttribute "type", sType  
      oNumberNode.setAttribute "id", "0"  
      If sQuickdial = "" Then  
        oNumberNode.setAttribute "vanity", ""  
      Else
        oNumberNode.setAttribute "quickdial", sQuickdial  
      End If
      oNumberNode.setAttribute "prio", "1"  
      oNumberNode.text = sNumber
      If sCategory <> "" Then oCategoryNode.text = "1"  
    End If
  End If
Wend

oFile.Close 'CSV Dateistream schließen  

' Stylesheet: XML Dokument mit Zeileneinrückung (damit es lesbar wird) und der korrekten Zeichencodierung versehen  
Set oXsltDoc = CreateObject("Msxml2.DOMDocument.6.0")  
oXsltDoc.async = False
oXsltDoc.loadXML( _
  "<?xml version=""1.0"" encoding=""windows-1252""?>" & vbNewLine & _  
  "<xsl:stylesheet version=""1.0"" xmlns:xsl=""http://www.w3.org/1999/XSL/Transform"">" & vbNewLine & _  
  "	<xsl:output method=""xml"" version=""1.0"" encoding=""iso-8859-1"" indent=""yes"" />" & vbNewLine & _  
  "	<xsl:template match=""node()|@*"">" & vbNewLine & _  
  "		<xsl:copy>" & vbNewLine & _  
  "			<xsl:apply-templates select=""node()|@*"" />" & vbNewLine & _  
  "		</xsl:copy>" & vbNewLine & _  
  "	</xsl:template>" & vbNewLine & _  
  "</xsl:stylesheet>")  
oXmlDoc.transformNodeToObject oXsltDoc, oXmlDoc

oXmlDoc.save(sXML_out) 'XML Dokument speichern