Fritzbox Telefonbuch - XML-Importdatei aus Excel erstellen

realName = ActiveCell.Offset(i, 0)

realName = Umlaut(ActiveCell.Offset(i, 0))

Sub XML_Export()
Dim strDateiname As String
Dim strDateinameZusatz As String
Dim strMappenpfad As String
Dim intCutExt

'Datename ohne Ext. (nach Punkt suchen):  
intCutExt = Len(ActiveWorkbook.Name) - InStrRev(ActiveWorkbook.Name, ".") + 1  
strMappenpfad = Left(ActiveWorkbook.FullName, Len(ActiveWorkbook.FullName) - intCutExt)

'strDateinameZusatz = "-" & Year(ActiveSheet.Cells(3, 1).Value) & "-" & Month(ActiveSheet.Cells(3, 1).Value) & ".xml"  
strDateinameZusatz = "-" & Format(Now, "YYYY-MM-DD-HH-MM-SS") & ".xml"  

strDateiname = InputBox("Bitte den Namen der XML-Datei angeben.", "XML-Export", strMappenpfad & strDateinameZusatz)  
If strDateiname = "" Then Exit Sub  

Range("A2").Select  

'Erstellt die Telefonbuchdatei (hier: xxx.xml)  
'Dateiname kann frei gewählt werden  
'Der entsprechende Ordner MUSS vorhanden sein, da sonst ein Fehler auftritt  
    Set fs = CreateObject("scripting.filesystemobject")  
    
    Set a = fs.createtextfile(strDateiname, True)

'Schreibt den allgemeinen Teil der Telefonbuchdatei  
    a.writeline ("<?xml version=" & """1.0""" & " encoding=" & """UTF-8""" & "?>")  
'    a.writeline ("<?xml version=" & """1.0""" & " encoding=" & """UTF-16""" & "?>")  
'    a.writeline ("<?xml version=" & """1.0""" & " encoding=" & """ISO-8859-1""" & "?>")  
    a.writeline ("<phonebooks>")  
    a.writeline ("<phonebook>")  
    'a.writeline ("<phonebook name=" & """Telefonbuch 1""" & " owner=" & """1""" & ">")  

'Schleife zur Ermittlung aller Einträge  
'Benutzt alle Datensätze, die einen Namen enthalten  
    i = 0
    While ActiveCell.Offset(i, 0) <> ""  
    
    Dim realName As String
    realName = Umlaut(ActiveCell.Offset(i, 0))
    Dim home As String
    home = ActiveCell.Offset(i, 1)
    Dim work As String
    work = ActiveCell.Offset(i, 2)
    Dim mobile As String
    mobile = ActiveCell.Offset(i, 3)
    Dim fax_work As String
    fax_work = ActiveCell.Offset(i, 4)

'Schreibt den Telefonbucheintrag  
    a.writeline ("<contact><category>0</category>")  
    a.writeline ("<person><realName>" + realName + "</realName></person><telephony>")  
    If home <> "" Then  
        a.writeline ("<number type=" & """home""" & " prio=" & """1""" & " id=" & """0""" & ">" + home + "</number>")  
    End If
    If work <> "" Then  
        a.writeline ("<number type=" & """work""" & " prio=" & """1""" & " id=" & """1""" & ">" + work + "</number>")  
    End If
    If mobile <> "" Then  
        a.writeline ("<number type=" & """mobile""" & " prio=" & """1""" & " id=" & """2""" & ">" + mobile + "</number>")  
    End If
    If fax_work <> "" Then  
        a.writeline ("<number type=" & """fax_work""" & " prio=" & """1""" & " id=" & """3""" & ">" + fax_work + "</number>")  
    End If
    a.writeline ("</telephony></contact>")  
    
    i = i + 1
    Wend
'Ende der Schleife  
    
'Ende der Telefonbuchdatei  
    a.writeline ("</phonebook>")  
    a.writeline ("</phonebooks>")  
    
MsgBox "Export erfolgreich. Datei wurde exportiert nach" & vbCrLf & strDateiname  
End Sub

Public Function Umlaut(Anything As Variant) As Variant
' https://dbwiki.net/wiki/VBA_Tipp:_Umlaute_ersetzen  
   Dim i        As Long
   Dim Ch       As String * 1
   Dim Ch1      As String * 1
   Dim Res      As String
   Dim IsUpCase As Boolean
 
   If IsNull(Anything) Then Umlaut = Null: Exit Function
 
   For i = 1 To Len(Anything)
      Ch = Mid$(Anything, i, 1)
      Ch1 = IIf(i < Len(Anything), Mid$(Anything, i + 1, 1), " ")  
      ' Nächstes Zeichen ist kein Kleinbuchstabe:  
      IsUpCase = CBool((Asc(Ch1) = Asc(UCase(Ch1))))
      Select Case Asc(Ch)
         Case Asc("Ä"): Res = Res & "Ä"  
         Case Asc("Ü"): Res = Res & "Ãœ"  
         Case Asc("Ö"): Res = Res & "Ö"  
         Case Asc("ü"): Res = Res & "ü"  
         Case Asc("ö"): Res = Res & "ö"  
         Case Asc("ä"): Res = Res & "ä"  
         Case Asc("ß"): Res = Res & "ß"  
         Case Else:     Res = Res & Ch
      End Select
   Next
   Umlaut = Res
End Function

strText = strText & "BlaBlub" & vbNewline  
strText = strText & "BlaBlub2" & vbNewline  
' usw.  

set xmldoc = CreateObject("MSXML2.DomDocument")  

' XML Document Object erstellen  
Set xmldoc = CreateObject("msxml2.domdocument.6.0")  
' Processing Instruction erstellen  
xmldoc.appendChild xmldoc.createProcessingInstruction("xml","version=""1.0"" encoding=""utf-8""")  
' Root-Knoten erstellen  
Set root = xmldoc.createElement("root")  
' Childknoten erstellen  
Set child = xmldoc.createElement("child")  
' Childknoten mit einem Attribut versehen  
child.setAttribute "name","Test"  
' Child Textknoten mit Inhalt füllen  
child.text = "BlaBLub"  
' Child-Knoten in den Root-Knoten einhängen  
root.appendChild child
' Root-Knoten in XML Document einhängen  
xmldoc.appendChild root
' Das ganze als XML wegspeichern  
xmldoc.save "D:\test.xml"   

<?xml version="1.0" encoding="utf-8"?> 
<root>
	<child name="Test">BlaBLub</child> 
</root>

BEGIN{
	FS=";"		#Trennzeichen  
	print "<?xml version=\"1.0\" encoding=\"utf-8\"?>"  
	print "<phonebooks>"  
	printf "%s", "<phonebook>"   
}
NR>1{
	name = $1
	sub("&", "&amp;", name)  
	unique_id = $2
	tel1_nr = $3
	tel1_art = $4
	tel2_nr = $5
	tel2_art = $6
	zeit = $7

	nid = 1
	if ( tel2_nr != "" ) nid = 2  

#zur Probe, damit alle Felder richtig erkannt werden
printf "NR=%s, name=%s, tel1_nr=%s, tel1_art=%s, tel2_nr=%s, tel2_art=%s\n", NR, name, tel1_nr, tel1_art, tel2_nr, tel2_art > "/dev/stderr"  

	printf "%s", "<contact>"  
	printf "%s", "<category>0</category>"  
	printf "%s", "<person>"  
	printf "%s%s%s", "<realName>", name, "</realName>"  
	printf "%s", "</person>"  
	printf "%s\n", "<telephony"   
	printf "%s%s%s", "nid=\"", nid, "\">"  
	printf "%s%s%s%s%s", "<number type=\"", tel1_art, "\" prio=\"1\" id=\"0\">", tel1_nr, "</number>"  
	if ( nid == 2 ) printf "%s\n%s%s%s%s%s", "<number ", "type=\"", tel2_art, "\" prio=\"1\" id=\"1\">", tel2_nr, "</number>"  
	print "</telephony><services /><setup /><features"  
	printf "%s", "doorphone=\"0\" />"  
	printf "%s%s%s", "<mod_time>", zeit, "</mod_time>"  
	printf "%s%s%s", "<uniqueid>", unique_id, "</uniqueid>"  
	printf "%s", "</contact>"  
}
END{
	print "</phonebook>"  
	print "</phonebooks>"  
}

#!/bin/bash
[ $# != 1 ] && echo "Aufruf: $0 <csv file>" && exit 
CSVFILE=$1
XMLFILE=`basename $CSVFILE .csv`.xml
TIME=$(date +%s)

echo -e '<?xml version="1.0" encoding="utf-8"?>\n<phonebooks>\n<phonebook owner="1" name="neues Telefonbuch">' > ${XMLFILE}  
while read -r datei1 ; do
    NAME=$(echo "$datei1" | cut -d";" -f2|tr \& +)  
    PHONE=$(echo "$datei1" | cut -d";" -f3)  
    ID=$(echo "$datei1" | cut -d";" -f1)  
    echo -e '<contact>\n\t<category>0</category>\n\t<person><realName>'"$NAME"'</realName></person>\n\t<telephony nid="1"><number type="work" prio="1" id="0">'"$PHONE"'</number></telephony>\n\t<uniqueid>'"$ID"'</uniqueid>\n</contact>' >> ${XMLFILE}  
done < ${CSVFILE}

echo -e '</phonebook>\n</phonebooks>' >> ${XMLFILE}