peterleb
Goto Top

Fritzbox Telefonbuch - XML-Importdatei aus Excel erstellen

Das Thema geistert schon seit Jahren durch verschiedene Foren.
Habe mich jetzt mal damit etwas intensiver befasst und hoffe, niemanden damit zu langweilen.

Also: Eine Excel-Datei mit 5 Spalten erstellen.

Z. Bsp

Name (realName) Telefon privat (home) Telefon geschäftlich (work) Telefon mobil (mobile) Fax (fax_work)


Die Spalten sollten als Text formatiert sein, dann lassen sich die die Telefonnummern besser eingeben (führende Null oder Pluszeichen).
Eine Formatierung bzw. Validierung der Nummern soll auch noch eingebaut werden.
Über Entwicklertools ein neues Makro anlegen und folgenden Code einfügen:

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 ("<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 = 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>")  
    a.writeline ("<number type=" & """home""" & " prio=" & """1""" & " id=" & """0""" & ">" + home + "</number>")  
    a.writeline ("<number type=" & """work""" & " prio=" & """1""" & " id=" & """1""" & ">" + work + "</number>")  
    a.writeline ("<number type=" & """mobile""" & " prio=" & """1""" & " id=" & """2""" & ">" + mobile + "</number>")  
    a.writeline ("<number type=" & """fax_work""" & " prio=" & """1""" & " id=" & """3""" & ">" + fax_work + "</number>")  
    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

Wenn man die erstellte XML-Datei in der Fritzbox zur Wiederherstellung des Telefonbuches benutzt, ergänzt die FB-Software selbst fehlende Bezeichner und Tags.
Achtung! Das vorhandene Telefonbuch wird immer überschrieben.

Nächster Schritt im Code wird das Ausfiltern leerer Zellen und Überlegungen zu weiteren sinnvollen Tags.
Und auch ein Import einer FB-Sicherungsdatei des Telefonbuches ist mittelfristig geplant.

Viel Vergnügen beim Anwenden und Experimentieren.
Für Hinweise bin ich sehr dankbar.

Viele Grüße
Peter

Content-Key: 502074

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

Ausgedruckt am: 19.03.2024 um 03:03 Uhr

Mitglied: PeterleB
PeterleB 08.10.2019 um 11:23:51 Uhr
Goto Top
Übrigens habe ich den Tipp auch im ip-phone-forum gepostet (Ich hoffe, das ist erlaubt)
Dort gab es noch Hinweise auf ein gleichnamiges Thema und einen gut beschriebenen Export/Import für XML bei Excel.

[ https://www.ip-phone-forum.de/threads/fritzbox-telefonbuch-xml-importdat ...]

Gruß Peter
Mitglied: silvereye
silvereye 21.10.2019 um 22:12:21 Uhr
Goto Top
Hallo Peter,

vorab danke für Deinen geposteten Code.
Ich habe soeben Deinen VBA code ausprobiert. Exceltabelle mit 5 Spalten, Überschriften Zeile 1, A-E wie Du es beschrieben hast definiert.
Code laufen lassen mit Ergebnis xml-Datei erzeugt.
Die erstellte xml-Datei habe ich versucht in meiner Fitzbox (7490, FRITZ!OS: 07.12) -> Telefonbuch -> Wiederherstellen -> hoch zu laden. Es erfolgt die Fehlermeldung: "Beim Wiederherstellen des Telefonbuchs ist ein Fehler aufgetreten."
Das Telefonbuch wurde nicht implementiert.

Hast Du vielleicht eine Ahnung warum nicht?

Viele Grüße
Mitglied: PeterleB
PeterleB 22.10.2019 um 07:31:38 Uhr
Goto Top
War mir auch mal passiert, muss aber in Ruhe rekapitulieren, woran es lag.
Melde mich wieder.

Gruß Peter
Mitglied: silvereye
silvereye 22.10.2019 um 22:03:28 Uhr
Goto Top
... OK, ich kann warten face-smile

Viel Grüße
Mitglied: PeterleB
PeterleB 24.10.2019 um 19:51:40 Uhr
Goto Top
Ich habe nochmal recherchiert.
Der VBA-Code enthält 2 kleine Fehler.

Zeile 29 a.writeline ("<phonebook") -> a.writeline ("<phonebook>")
Zeile 64 a.writeline ("</phonebooks") -> a.writeline ("</phonebooks>")

Es fehlten jeweils die Tag-Klammern ">".

Probiere es bitte nach Korrektur nochmal.

Gruß Peter
Mitglied: PeterleB
PeterleB 24.10.2019 um 19:56:21 Uhr
Goto Top
Habe 2 kleine Fehler im Code korrigiert.
Mitglied: PeterleB
PeterleB 24.10.2019 aktualisiert um 21:47:03 Uhr
Goto Top
Das Ausfiltern leerer Zellen sieht im Code ab Zeile 49 dann so aus:

'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  

Die Number ID (0 - 3) korrigiert die Fritz!Box beim Import selbst.
Mitglied: silvereye
silvereye 27.10.2019 um 16:28:14 Uhr
Goto Top
Hallo Peter,

ich habe den Codebereich (49-60) mit Deinem neuen Quelltext ersetzt.
Leider kommt wieder die Fehlermeldung: "Beim Wiederherstellen des Telefonbuchs ist ein Fehler aufgetreten."
Bei Dir funktioniert es? Wenn ja welche Software hast Du auf der Fritzbox?

Viele Grüße
Mitglied: PeterleB
PeterleB 27.10.2019 um 22:55:54 Uhr
Goto Top
Das Wichtige sind nicht die neuen Zeilen Code, sondern die ursprünglich fehlenden ">"

in den Zeilen 29 und 64

a.writeline ("<phonebook") -> a.writeline ("<phonebook>")
a.writeline ("</phonebooks") -> a.writeline ("</phonebooks>")

Hast Du das korrigiert?

Gruß Peter
Mitglied: silvereye
silvereye 28.10.2019 um 21:30:42 Uhr
Goto Top
Hallo Peter,

Deine beiden beschriebenen Änderungen hatte ich leider vergessen.
Ich habe nun auch die Zeilen 29 + 64 geändert. Zuerst hat es nicht funktioniert.
Nach langen herumprobieren mit:
- Leerzeichen in der Nummer
- Anzahl der Nummern pro Zeile
- Länderkennung (z.B. +49)
- Namen: Nachname, Vorname oder nur ein Name
- Viele Einträge oder wenige bis nur einen Eintrag
konnte ich den Fehler finden.

Wenn man Umlaute bei den Namen verwendet, funktioniert es nicht.
Wenn man das über einem Browser direkt manuell eingibt funktioniert es aber.
Genau so an meinem Handaparat. Nur nicht über die Eingabe in der Tabelle mit anschließendem Lauf des Makros.
Beim Namen "Rüdiger" steht in der xml-Datei dann:

xml-umlaute

Ich habe deshalb hierzu dann das Attribut in der Zeile 27 von:
27 :a.writeline ("<?xml version=" & """1.0""" & " encoding=" & """utf-8""" & "?>")
in
27: a.writeline ("<?xml version=" & """1.0""" & " encoding=" & """ISO-8859-1""" & "?>")
geändert. Das Makro mit anschließender Wiederherstellung in der FitzBox Oberfläche funktioniert dann auch mit Umlauten.

Spricht aus Deiner Sicht hier etwas gegen diese Änderung bzw. kann das noch zu anderen Fehlern führen?

Viele Grüße
Mitglied: PeterleB
PeterleB 29.10.2019 um 17:59:56 Uhr
Goto Top
Du bist ja ein Fuchs!
Schön, dass Du das Problem gefunden hast.

Den Code selbst habe ich ja auch teilweise übernommen, insbesondere die Zeile mit der xml-Version.
Die Fritz!Box selbst schreibt in den Export "UTF-8".

Ich weiss leider nicht, ob die Änderung zu Problemen führen kann.
Für UTF-8 müßten wir halt den Zelleninhalt auf Umlaute und Sonderzeichen prüfen und statt "ü" dann "&uuml;" schreiben.
Überraschenderweise enthält aber die exportierte Sicherung der Fritz!Box die Umlaute in Klartext-Umlauten.

Habe im Augenblick keinen richtigen Plan.

Gruß Peter
Mitglied: silvereye
silvereye 31.10.2019 um 21:52:04 Uhr
Goto Top
Hallo Peter,

da die Fritzbox die ISO-8859-1 konvertierte xml-Datei lesen kann sehe ich jetzt erst mal keinen weiteren Handlungsbedarf.
Ich habe aber Deinen Code für die UTF-8 ein bisschen für die Umlaute angepasst.
Aus Zeile 39:
realName = ActiveCell.Offset(i, 0)
habe ich eine Funktion von der Seite dbwiki.net/wiki/VBA_Tipp:_Umlaute_ersetzen ein bisschen angepasst und eingefügt zu:
realName = Umlaut(ActiveCell.Offset(i, 0))
Umlaut verweist auf die hinzugefügte Funktion am Ende:
In Summe sieht das dann so aus:
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
Mitglied: PeterleB
PeterleB 01.11.2019 um 07:41:26 Uhr
Goto Top
Das gefällt mir.

Gruß Peter
Mitglied: 141575
141575 01.11.2019 aktualisiert um 08:02:06 Uhr
Goto Top
Wenn ihr UTF-8 in den Header der XML Datei schreibt dann sollte diese auch UTF-8 kodiert weggeschrieben werden ! Das FSO Textobject kann das nicht, es kann außer ASCII und Ansi nur Unicode, aber mit Adodb.Stream ist UTF-8 kein Problem:
https://developer.rhino3d.com/guides/rhinoscript/read-write-utf8/
Mitglied: PeterleB
PeterleB 01.11.2019 um 14:49:20 Uhr
Goto Top
Vielen Dank für den Hinweis.
Das schaue ich mir an.

Gruß Peter
Mitglied: PeterleB
PeterleB 02.11.2019 um 16:11:23 Uhr
Goto Top
objStream.WriteText schreibt jedoch nicht zeilenweise, sondern immer einen "Datenblock".
Über eine Hilfsvariable müßten also erst die Zeileninhalte gesammelt, mit Zeilenendezeichen versehen und dann in einem Rutsch in den Stream geschrieben werden.
Ist sicher machbar, aber braucht etwas Arbeit.

Gruß Peter
Mitglied: 141575
141575 02.11.2019 aktualisiert um 16:15:36 Uhr
Goto Top
Zitat von @PeterleB:

objStream.WriteText schreibt jedoch nicht zeilenweise, sondern immer einen "Datenblock".
Richtig
Über eine Hilfsvariable müßten also erst die Zeileninhalte gesammelt, mit Zeilenendezeichen versehen und dann in einem Rutsch in den Stream geschrieben werden.
Exakt, ist ja kein Thema ...
strText = strText & "BlaBlub" & vbNewline  
strText = strText & "BlaBlub2" & vbNewline  
' usw.  
Ist sicher machbar, aber braucht etwas Arbeit.
That's Life face-smile, dafür ist's hinterher aber auch in der richtigen Kodierung, wer weiß was die Leute so sonst noch an Zeichen in Ihre Kontakte packen...
Mitglied: PeterleB
PeterleB 02.11.2019 aktualisiert um 17:09:59 Uhr
Goto Top
Wie groß darf denn so eine Stringvariable und ein Streamobjekt werden?
Stell Dir mal ein Fritz-Telefonbuch mit 500 Einträgen vor.

Gruß Peter


PS: Selbstgefunden: 65535 Zeichen im String.
Mitglied: 141575
141575 02.11.2019 aktualisiert um 17:11:20 Uhr
Goto Top
Zitat von @PeterleB:

Wie groß darf denn so eine Stringvariable
So viel du RAM hast
und ein Streamobjekt werden?
Das Streamobject ist nicht groß, das schreibt die Dinge direkt so weg in die Datei wie sie ankommen.
Stell Dir mal ein Fritz-Telefonbuch mit 500 Einträgen vor.
Das ist ehrlich gesagt "mini" face-smile und überhaupt kein Problem. Performance- und Speichertechnisch wäre natürlich ein "StringBuilder" effektiver aber das gibt's in VBS nicht nur in .NET.

Aber ich würde an deiner Stelle das XML direkt mit einem XML-Object erstellen face-wink
set xmldoc = CreateObject("MSXML2.DomDocument")  
Und das macht dann auch gleich die Kodierung richtig!
Mitglied: PeterleB
PeterleB 02.11.2019 aktualisiert um 17:16:28 Uhr
Goto Top
Da müßte ich mich wirklich mal reinknien.
Bin doch nur eine gelegenheits-Hobby-Programmierer.
Funktioniert das auch mit VBA?
Mitglied: 141575
141575 02.11.2019 um 17:17:06 Uhr
Goto Top
Zitat von @PeterleB:
Funktioniert das auch mit VBA?
Ja hervorragend.
Mitglied: 141575
141575 02.11.2019 aktualisiert um 17:30:46 Uhr
Goto Top
Hier mal ein einfaches Beispiel:
' 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"   

Ergibt als Beispiel
<?xml version="1.0" encoding="utf-8"?> 
<root>
	<child name="Test">BlaBLub</child> 
</root>
Vollkommen objektorientiert ohne das String-Gematsche und vor allem das wichtigste: Du erhältst zuverlässig gültigen XML Code ohne eventuelle Flüchtigkeitsfehler(Groß-Kleinschreibung etc.) weil es ein echter XML Parser erstellt face-smile.
Mitglied: PeterleB
PeterleB 02.11.2019 um 17:42:16 Uhr
Goto Top
Danke.
Ist trotzdem schwerer "Tobak" für mich.

Jetzt geht's erstmal zu 'ner Geburtstagsfeier.

Gruß Peter
Mitglied: Silbercode
Silbercode 24.06.2020 aktualisiert um 15:06:21 Uhr
Goto Top
@141575: Allerherzlichsten Dank für dieses hervorragende „uTutorial“!
Mitglied: Hemingway
Hemingway 07.09.2020 um 15:27:22 Uhr
Goto Top
Hallo Experten,
auch ich möchte gern meine Telefonkontakte in Gestalt einer Excel-Tabelle so umwandeln, dass ich sie in meine FB 7590 importieren kann. Zu diesem Zweck hab ich mein Bestes getan, Eure Erörterungen nachzuvollziehen.
Dann habe ich den Code ganz oben im 1. Beitrag (67 Zeilen), dann den erweiterten von silvereye vom 31.10.2019 um 21:52 Uhr (105 Zeilen) als Excel-Macros laufen lassen. Leider führten beide beim FritzBox-Import zu der bekannten Fehlermeldung.
Nun bin ich als Laie aufgeschmissen, denn ich frage mich:
• Gibt es denn inzwischen einen "fertigen" Macro-Code, in dem alle Vorschläge, Anregungen etc. umgesetzt sind und der eine XML produziert, die die FB klaglos akzeptiert?
• Wenn nein, was muss ich tun?
Danke für jeden Hinweis!
Gruß Alex
Mitglied: PeterleB
PeterleB 07.09.2020 um 16:41:49 Uhr
Goto Top
Habe mich leider auch noch nicht darüber her gemacht.

Die ganzen Writeline-Anweisungen müssen in richtiger Reihenfolge in createElement, setAttribute, text und appendChild umgebastelt werden.
Das bedarf ein wenig Denk- und Fleißarbeit.

Gruß Peter
Mitglied: PeterleB
PeterleB 07.09.2020 um 19:08:20 Uhr
Goto Top
Habe doch mal angefangen, mir ein paar Gedanken zu machen.

Erstmal zum Vergleich eine reelle Telefonbuchdatei:

<?xml version="1.0" encoding="utf-8"?>  
<phonebooks>
<phonebook name="Kombi">  

<contact>
	<category>0</category>
	<person>
		<realName>Lutzmann, Utz
		</realName>
		<imageURL>file:///var/InternerSpeicher/FRITZ/fonpix/1564409969-0.jpg
		</imageURL>
	</person>
	<telephonynid="2">  
		<number type="mobile" prio="1" id="0">+491721111111  
		</number>
		<numbertype="home" prio="0" id="1">+4933332222222  
		</number>
	</telephony>
	<servicesnid="1">  
		<email classifier="private" id="0">lutzmann.utz@web.de  
		</email>
	</services>
	<uniqueid>1112
	</uniqueid>
	<mod_time>1564409969
	</mod_time>
</contact>


</phonebook>
</phonebooks>

Nach dem Beispiel von "141575" müsste es sich - erstmal als Gedankengerüst - so entwickeln:

								' XML Document Object erstellen  
								Set xmldoc = CreateObject("msxml2.domdocument.6.0")  
								' Processing Instruction erstellen  
<?xml version="1.0" encoding="utf-8"?>	xmldoc.appendChild xmldoc.createProcessingInstruction("xml","version=""1.0"" encoding=""utf-8""")  


<phonebooks>				' Root-Knoten erstellen: Set root = xmldoc.createElement("phonebooks")  
    <phonebook>				' Childknoten erstellen: Set child = xmldoc.createElement("phonebook")  
							' Childknoten mit einem Attribut versehen: child.setAttribute "name","Telefonbuch 1"  
							' Childknoten mit einem 2. Attribut versehen: child.setAttribute "owner","1"  
							' Mit dieser Anweisung bin ich mir gar nicht so sicher!  
								
		<phonebook name=" & """Telefonbuch 1""" & " owner=" & """1""" & ">")  
								
		
		'Jetzt als Schleife:  
		'Ermittlung aller Einträge  
		'Zeile 36 - 48  
		
		<contact>				'Child unter Child! Da hört's bei mir schon auf. Set child01 = xmldoc.createElement("contact") ???  
			<category>0
			</category>
			<person>
				<realName>" + realName + "  
				</realName>
			</person>
			<telephony>
				Wenn die Tags <> ""  
				<number type=" & """home""" & " prio=" & """1""" & " id=" & """0""" & ">" + home + "  
				</number>
				<number type=" & """work""" & " prio=" & """1""" & " id=" & """1""" & ">" + work + "  
				</number>
				<number type=" & """mobile""" & " prio=" & """1""" & " id=" & """2""" & ">" + mobile + "  
				</number>
				<number type=" & """fax_work""" & " prio=" & """1""" & " id=" & """3""" & ">" + fax_work + "  
				</number>
			</telephony>
		</contact>			' Child-Knoten in den Child-Knoten einhängen: child.appendChild contact ????  
		
		Ende der Schleife
		
	</phonebook>			' Child-Knoten in den Root-Knoten einhängen: root.appendChild phonebook  
</phonebooks>				' Root-Knoten in XML Document einhängen: xmldoc.appendChild phonebooks  

Leider komme ich hier nicht weiter. Habe auch nur bei .NET ausführlichere Erklärungen zu msxml2.domdocument.6.0 gefunden, die sich aber nicht 1:1 für VBA umsetzen lassen.
Vielleicht gibt es noch einen Code-Tüftler, der hier helfen kann.

Gruß Peter
Mitglied: silvereye
silvereye 07.09.2020 um 19:27:41 Uhr
Goto Top
Hallo Hemmingway und PeterleB,

habt Ihr mal folgendes versucht:

1. Eigenes Telefonbuch der FritzBox sichern

2. Tabelle (xlsm) erstellen mit den Überschriften (A1 bis E1):
A1: Name (realName)
B1: Telefon privat (home)
C1: Telefon geschäftlich (work)
D1: Telefon mobil (mobile)
E1: Fax (fax_work)

3. Dann bitte mal ein paar Beispielkontakte in die Tabelle schreiben

4. Ein Modul mit dem Code (siehe oben vom 31.10.2019 um 21:52 Uhr, den Block mit den Zeilen 1-67) einfügen und speichern

5. Makro "Sub XML_Export" ausführen

6. Die erstellte Datei auf die FritzBox hochladen und überprüfen ob alles übertragen worden ist.

Gruß silvereye
Mitglied: PeterleB
PeterleB 07.09.2020 um 19:49:08 Uhr
Goto Top
Bitte mal am 27.10.19 lesen.
Der so erzeugte XML-Text ist leider kein UTF-8, wodurch wegen der fehlerhaften Umlautcodierung Importfehler bei der FB entstehen und der Vorgang abgebrochen wird.

Gruß Peter
Mitglied: Hemingway
Hemingway 09.09.2020 um 23:08:53 Uhr
Goto Top
Hallo silvereye,
ja, das habe ich alles schon gemacht, siehe mein Post vom 07.09.2020 um 15:27 Uhr.
Nun schreibst Du, wir sollen den "Code (siehe oben vom 31.10.2019 um 21:52 Uhr, den Block mit den Zeilen 1-67) einfügen". Das versteh ich nicht, denn der Code dort hat doch 105 Zeilen ...
Gruß Alex
Mitglied: ConnyTheNerd
ConnyTheNerd 01.02.2021 aktualisiert um 18:55:30 Uhr
Goto Top
Da das Thema ja immer noch aktuell ist - habe eine Fritzbox 7590 SX - habe ich ein Skript für Linux-User gemacht (vielleicht hilft's dem einen oder anderen):

Arbeite mit Ubuntu 20.04 als Hinweis.
Calc Datei anlegen mit 4 Spalten, Spalte A: Name, Spalte B: Telefonnummer, Spalte C: Zeit, Spalte D: ID anlegen, entsprechend ausfüllen, dann die ods datei mit "speichern unter" als csv (rechtes Pull-Down Menü)- Filter-Einstellungen bearbeiten anklicken (links), dann Dateinamen eingeben und speichern anklicken, dann CSV-Format verwenden anklicken, als Filteroptionen auswählen UTF8, als Feldtrenner Strichpunkt wählen, Zeichenketten-Trenner ", Zellinhalt wie angezeigt, mit OK bestätigen. Beim Öffnen dieser Datei dann die Überschriftenzeile löschen


#!/bin/bash
set -xv
echo -e '<?xml version="1.0" encoding="utf-8"?>\n<phonebooks>\n<phonebook owner="1" name="20210128Conny">' >> Test1
while read -r datei1
do
NAME=$(echo "$datei1" | cut -d";" -f1)
PHONE=$(echo "$datei1" | cut -d";" -f2)
TIME=$(echo "$datei1" | cut -d";" -f3)
ID=$(echo "$datei1" | cut -d";" -f4)
echo -e '<contact>\n<category>1</category>\n<person>\n<realName>'"$NAME"'</realName>\n</person>\n<telephony nid="1">\n<number type="work" prio="1" id="0">'"$PHONE"'</number>\n</telephony>\n<services/>\n<setup/>\n<features doorphone="0"/>\n<mod_time>'"$TIME"'</mod_time>\n<uniqueid>'"$ID"'</uniqueid>\n</contact>' >> Test1
done < WieAuchImmerDuDeineDateiGenanntHast.csv
echo -e '</phonebook>\n</phonebooks>' >> Test1


Kurze Erläuterung:

Datei Test1 umbenennen in Test1.xml (oder wie gewünscht), dann testweise im Browser öffnen lassen. Kann sein, dass bestimmte Zeilen als Fehler gemeldet werden, passiert bei bestimmten Zeichen im Namen, z.B. bei diesem "&", das entsprechend ändern. Dann sollte der Import klappen.
Mitglied: Hemingway
Hemingway 03.02.2021 um 22:51:10 Uhr
Goto Top
Wow, das sieht gut aus (und nach einer Menge Nachdenken und Arbeit). Vielen Dank!
Ich hatte ehrlich gesagt gar nicht mehr mit einer Antwort gerechnet, einfach alles liegengelassen und mich mit anderen Projekten befasst, in denen ich jetzt versunken bin.
Ich werde das Skript baldmöglichst ausprobieren, bitte aber um Geduld.
Gruß,
Alex
Mitglied: ConnyTheNerd
ConnyTheNerd 05.02.2021 um 17:07:44 Uhr
Goto Top
Aber gerne doch!

Gibt bestimmt noch mehr Linux-User, die wie ich verblüfft feststellen, dass die Fritzbox keine .csv importieren kann und dass man dann leider an den angeschlossenen DECT-Hörern aufgeschmissen ist.

Und die verzweifelte Suche im "Gockel" gibt auch nicht viel her - außer hier! Aber halt Windows ...
Mitglied: musikfreund
musikfreund 01.03.2021 um 21:59:32 Uhr
Goto Top
Hallo allerseits,

ich habe seit kurzem eine FB 7530, in die ich auch meine Kontaktdaten importieren möchte. Folgender Weg funktioniert bei mir auf meinem Windows-Rechner:

  • Exceldatei als Datenbank nutzen und Export in CSV-Datei
  • AWK-Skript darüberlaufen lassen und XML-Datei erzeugen
  • diese resultierende XML-Datei editieren mit notepad++, um sicherzustellen, dass
  • Umlaute in utf-8 sind,
  • neue Zeilen als Unix (LF) geschrieben werden.

Probleme gab es, wenn mehr als zwei Nummern einem Namen zugeordnet sind. Mit meinem Skript klappen zwei Nummern. Drei oder mehr habe ich nicht weiter probiert, weil ich das nicht brauche.

Die Einzelheiten.

Die Exceldatei hat in der ersten Zeile folgende Felder:
a1: Name
b1: unique_id
c1: tel1_nr
d1: tel1_art
e1: tel2_nr
f1: tel2_art
g1: zeit

  • die unique_id ist beliebig aufsteigend
  • die Art der Nummer kann sein: home, mobile, work, oder fax_work
  • die Zeit ist eine 11-stellige Zahl, die ich erzeuge, indem ich die unique_id zu 1614597940 addiere


AWK:

Befehl im DOS-Fenster: gawk -f fb.awk fb.csv > fb.xml

ich nutze die gawk-Version 3.1.6

Die AWK-Datei heißt fb.awk und sieht so aus:
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>"  
}

Viele Grüße,
Andreas
Mitglied: paulmx
paulmx 14.08.2021 um 16:39:44 Uhr
Goto Top
@ musikfreund

Hallo, ich würde mich da gerne dran versuchen, bekomme allerdings nicht einmal AWK zum Laufen (Windows7 64 bit).
"Der Befehl gawk ist falsch geschrieben oder konnte nicht gefunden werden"
Hast Du vielleicht eine brauchbare Anleitung zur Installation von AWK auf Deutsch?
Mitglied: musikfreund
musikfreund 15.08.2021 um 09:03:14 Uhr
Goto Top
Die Awk-Datei muss entweder im selben Pfad liegen wie Deine Dateien oder im Systempfad. Am einfachsten ist es sicherlich, die Awk-Datei zunächst im selben Pfad abzuspeichern, damit Windows sie auch findet. Wenn alles funktioniert, kannst Du sie in den Systempfad kopieren (path=).

Hier kannst Du Gawk runterladen:
https://www.softpedia.com/get/CD-DVD-Tools/CD-DVD-Images-Utils/Gawk-for- ...
Mitglied: paulmx
paulmx 15.08.2021 um 11:31:33 Uhr
Goto Top
Hab den Fehler noch nicht gefunden, es bleibt bei
"Der Befehl gawk ist falsch geschrieben oder konnte nicht gefunden werden".

Sicherheitshalber hab ich AWK nochmal deinstalliert, Neustart und wieder neu installiert. Dabei deinen Link und Download verwendet. Win7 installiert dann von Haus aus unter c:\program files (x86)\gnuwin32\ und dabei hab ich es auch belassen.
Die .csv und fb.awk genau in den selben Pfad und Ordner kopiert.
Die Dos CMD im normalen Modus sowie im Admin-Modus gestartet und den Befehl "gawk -f fb.awk fb.csv > fb.xml"
(Name .csv angepasst) im selben Pfad gestartet.
Die Fehlermeldung bleibt leider.
Oder nimmst eine andere Shell als die Dos CMD?
Mitglied: paulmx
paulmx 15.08.2021 um 13:09:57 Uhr
Goto Top
Bleibt in Powershell (x86) mit einer ähnlichen Fehlermeldung:
"Die Benennung "gawk" wurde nicht als Name eines Cmdlet, einer Funktion, einer Skriptdatei oder eines ausführbaren Programms erkannt. Überprüfen Sie..."
Spaßeshalber habe ich in allen Varianten mal mit "awk" (statt "gawk") im Befehlscode gearbeitet, die Fehlermeldung verändert sich nur auf "awk", bzw. "gawk"

Was mache ich hier falsch?
Mitglied: musikfreund
musikfreund 15.08.2021 um 14:39:46 Uhr
Goto Top
das ist komisch. Hier ist das, was ich in Win 10 eingebe:

1: mit rechter Maus auf Start-Button und "Ausführen" anklicken.
2: "cmd" eingeben und ENTER drücken. Die schwarze DOS-shell sollte erscheinen.
3: in den Pfad Deiner Wahl gehen. dort sollten alle Dateien liegen.
4: zur Probe eingeben: "gawk" und ENTER drücken, s. Bild

fb

5. jetzt sollte USAGE erscheinen, d.h. welche Parameter gawk braucht. Wenn das funktioniert, sollte der Rest auch klappen.
Mitglied: paulmx
paulmx 15.08.2021 um 15:13:41 Uhr
Goto Top
Fehler gefunden: ich hatte mich schon gewundert, dass nach der Installation keine .exe Datei angezeigt wurde. Tatsächlich liegt die "gawk.exe" im Unterordner "bin"; kann auch nur von dort mit "gawk -f..." die Bearbeitung starten.
Eine Hürde geschafft face-smile - vielen Dank für Deine Hilfe & Geduld !!!

Im Notepad++
Umlaute unter Kodierung "Konvertiere zu utf-8" ? und
Bearbeiten - Format Zeilenende neue Zeilen als Unix (LF) ?

- reicht hier das Abspeichern mit diesen Werten oder muss irgendwie eine Bearbeitung gestartet werden?
Mitglied: musikfreund
musikfreund 15.08.2021 um 15:52:18 Uhr
Goto Top
das Abspeichern reicht, so weit ich mich erinnere. notepad++ zeigt mit "*" vor dem Pfad an, wenn sich etwas geändert hat.
Mitglied: paulmx
paulmx 15.08.2021 um 19:00:32 Uhr
Goto Top
Ja, richtig. Zeigt oben im Pfad ein * an, sobald sich was verändert hat. Dann einfach speichern.
Allerdings nimmt die FritzBox die Datei nicht an "...es ist ein Fehler aufgetreten..."
Auf jeden Fall ist der Weg jetzt klar, ich werde mich morgen Mittag nochmal in aller Ruhe ransetzen und "sauber" von Vorne anfangen.

In jedem Fall DANKE für deine Hilfe & Geduld !
Mitglied: zeichenschubser
zeichenschubser 08.11.2021 aktualisiert um 12:56:11 Uhr
Goto Top
Zitat von @ConnyTheNerd:

Gibt bestimmt noch mehr Linux-User, die wie ich verblüfft feststellen, dass die Fritzbox keine .csv importieren kann und dass man dann leider an den angeschlossenen DECT-Hörern aufgeschmissen ist.

Und die verzweifelte Suche im "Gockel" gibt auch nicht viel her - außer hier! Aber halt Windows ...

Danke für das schöne Skript! Das ist genau das, was ich suchte.

Meine Anforderung war, einen Adressbuchexport mit >1300 Einträgen aus der Telekom CloudPBX in die FritzBox zu integrieren. Das kann leider nur manuell geschehen, da die CloudPBX sehr zugeknöpft ist, was Synchronisation angeht.

Ich habe das Skript an die Exportstruktur angepasst und etwas universeller gemacht. Beim Import bin noch über eine weitere Beschränkung gestolpert, die ich in Zeile 9 ebenfalls gefixt habe.

Hier meine überarbeitete Version:
#!/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}  
Das Skript wird mit der CSV Datei als Argument aufgerufen. In Zeile 2 prüfe ich, ob ein Argument übergeben wurde und setze in Z3 dann die Variable entsprechend. In Z4 erzeuge ich den Ausgabenamen anhand der Eingabedatei und ersetze .csv durch .xml. In Z7 wird die Ausgabedatei immer neu erzeugt, eine vorhandene also überschrieben. Ein Anhängen macht ohne Nacharbeit bei einer XML Datei sowieso keinen Sinn.
In Z9 ersetze ich noch auftretende "&" durch "+", denn das "&" mag die FB nicht.
In Z12 habe ich ein paar m.E. unnötige Entities entfernt und vor allem die category auf 0 gesetzt, sonst wären alle Kontakte als wichtig markiert. Kann aber jeder natürlich selbst entscheiden.

Ach ja, der Output ist auch noch ein bissl umformatiert, damit MENSCH das XML etwas besser lesen kann.

Vielleicht hilft es noch jemandem weiter.
Mitglied: Moreteen
Moreteen 06.03.2022 um 23:07:41 Uhr
Goto Top
Hallo Peterle,
also bei mir funktioniert das mit dem Makro nicht.
Ich bekommr eine leere Telefonliste.
Kannst du vielleicht zeigen wie die Excel Tabelle aussieht?
Ich habe die telefonnummern in eine Spalte eingefügt und ein Makro mit Deinem Code erstellt.

LG, Moreteem
Mitglied: Moreteen
Moreteen 08.03.2022 um 23:02:49 Uhr
Goto Top
Ich habs so gemacht wie Mitglied: silvereye
silvereye 07.09.2020 um 19:27:41 Uhr.
So gings.
Schade dass man nur 5 Spalten hat und nicht mehr.
Kann man den Code irgendwie erweitern für mehr Spalten?

Gruß, Moreteen
Mitglied: PeterleB
PeterleB 10.03.2022 um 16:39:43 Uhr
Goto Top
Hallo,

das sollte kein Problem sein.
Unter Verwendung des Codes von silvereye:

ab Zeile 46 neue Variablen definieren
Dim Feld5 As String
    Feld5 = ActiveCell.Offset(i, 5)
Dim Feld6 As String
    Feld6 = ActiveCell.Offset(i, 6)
...
und nach Zeile 64
If Feld5 <> "" Then  
        a.writeline ("<number type=" & """Feld5""" & " prio=" & """1""" & " id=" & """3""" & ">" + Feld5 + "</number>")  
    End If
If Feld6 <> "" Then  
        a.writeline ("<number type=" & """Feld6""" & " prio=" & """1""" & " id=" & """3""" & ">" +Feld6 + "</number>")  
    End If
...
Das ist nur beispielhaft! Der genaue Inhalt der zu schreibenden Zeile muss an die Anforderungen der "Felder" angepasst werden.
Welche Werte willst Du denn noch übergeben?

Gruß
Peter
Mitglied: Moreteen
Moreteen 11.03.2022 um 08:49:14 Uhr
Goto Top
Hallo Peter, danke für Deine Antwort.
Ich möchte eine Sperrliste für unliebsame Telefonnummern erstellen.
Das soll dann so aussehen: Sperrliste1/20 Nummern, Sperrliste2/20Nummern u.s.w.

Gruß, Martin
Mitglied: Moreteen
Moreteen 11.03.2022 um 10:05:21 Uhr
Goto Top
Hallo Peter,
das hat prima geklappt.
Vielen herzlichen Dank.
Das Einzige was ich mich frage ist wehalb in den ersten 4 Spalten immer noch
privat), (geschäftl.), (mobil), (Fax) steht obwohl ich "Dim Feld1 As String
Feld1 = ActiveCell.Offset(i, 1) bzw. If Feld1 <> "" Then
a.writeline ("<number type=" & """Feld1""" & " prio=" & """1""" & " id=" & """3""" & ">" + Feld1 + "</number>")
End If
u.s.w. geschrieben habe.
Hier ist das vollständige Makro:

Sub xml()
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
'Horizontale Spalte
i = 0
While ActiveCell.Offset(i, 0) <> ""

Dim realName As String
realName = Umlaut(ActiveCell.Offset(i, 0))
Dim Feld1 As String
Feld1 = ActiveCell.Offset(i, 1)
Dim Feld2 As String
Feld2 = ActiveCell.Offset(i, 2)
Dim Feld3 As String
Feld3 = ActiveCell.Offset(i, 3)
Dim Feld4 As String
Feld4 = ActiveCell.Offset(i, 4)
Dim Feld5 As String
Feld5 = ActiveCell.Offset(i, 5)
Dim Feld6 As String
Feld6 = ActiveCell.Offset(i, 6)
Dim Feld7 As String
Feld7 = ActiveCell.Offset(i, 7)
Dim Feld8 As String
Feld8 = ActiveCell.Offset(i, 8)
Dim Feld9 As String
Feld9 = ActiveCell.Offset(i, 9)
Dim Feld10 As String
Feld10 = ActiveCell.Offset(i, 10)
Dim Feld11 As String
Feld11 = ActiveCell.Offset(i, 11)
Dim Feld12 As String
Feld12 = ActiveCell.Offset(i, 12)
Dim Feld13 As String
Feld13 = ActiveCell.Offset(i, 13)
Dim Feld14 As String
Feld14 = ActiveCell.Offset(i, 14)
Dim Feld15 As String
Feld15 = ActiveCell.Offset(i, 15)
Dim Feld16 As String
Feld16 = ActiveCell.Offset(i, 16)
Dim Feld17 As String
Feld17 = ActiveCell.Offset(i, 17)
Dim Feld18 As String
Feld18 = ActiveCell.Offset(i, 18)
Dim Feld19 As String
Feld19 = ActiveCell.Offset(i, 19)
Dim Feld20 As String
Feld20 = ActiveCell.Offset(i, 20)

'Vertikale Spalte
'Schreibt den Telefonbucheintrag
a.writeline ("<contact><category>0</category>")
a.writeline ("<person><realName>" + realName + "</realName></person><telephony>")
If Feld1 <> "" Then
a.writeline ("<number type=" & """home""" & " prio=" & """1""" & " id=" & """0""" & ">" + Feld1 + "</number>")
End If
If Feld2 <> "" Then
a.writeline ("<number type=" & """work""" & " prio=" & """1""" & " id=" & """1""" & ">" + Feld2 + "</number>")
End If
If Feld3 <> "" Then
a.writeline ("<number type=" & """mobile""" & " prio=" & """1""" & " id=" & """2""" & ">" + Feld3 + "</number>")
End If
If Feld4 <> "" Then
a.writeline ("<number type=" & """fax_work""" & " prio=" & """1""" & " id=" & """3""" & ">" + Feld4 + "</number>")
End If
If Feld5 <> "" Then
a.writeline ("<number type=" & """Feld5""" & " prio=" & """1""" & " id=" & """3""" & ">" + Feld5 + "</number>")
End If
If Feld6 <> "" Then
a.writeline ("<number type=" & """Feld6""" & " prio=" & """1""" & " id=" & """3""" & ">" + Feld6 + "</number>")
End If
If Feld7 <> "" Then
a.writeline ("<number type=" & """Feld5""" & " prio=" & """1""" & " id=" & """3""" & ">" + Feld7 + "</number>")
End If
If Feld8 <> "" Then
a.writeline ("<number type=" & """Feld6""" & " prio=" & """1""" & " id=" & """3""" & ">" + Feld8 + "</number>")
End If
If Feld9 <> "" Then
a.writeline ("<number type=" & """Feld5""" & " prio=" & """1""" & " id=" & """3""" & ">" + Feld9 + "</number>")
End If
If Feld10 <> "" Then
a.writeline ("<number type=" & """Feld6""" & " prio=" & """1""" & " id=" & """3""" & ">" + Feld10 + "</number>")
End If
If Feld11 <> "" Then
a.writeline ("<number type=" & """Feld5""" & " prio=" & """1""" & " id=" & """3""" & ">" + Feld11 + "</number>")
End If
If Feld12 <> "" Then
a.writeline ("<number type=" & """Feld6""" & " prio=" & """1""" & " id=" & """3""" & ">" + Feld12 + "</number>")
End If
If Feld13 <> "" Then
a.writeline ("<number type=" & """Feld5""" & " prio=" & """1""" & " id=" & """3""" & ">" + Feld13 + "</number>")
End If
If Feld14 <> "" Then
a.writeline ("<number type=" & """Feld6""" & " prio=" & """1""" & " id=" & """3""" & ">" + Feld14 + "</number>")
End If
If Feld15 <> "" Then
a.writeline ("<number type=" & """Feld6""" & " prio=" & """1""" & " id=" & """3""" & ">" + Feld15 + "</number>")
End If
If Feld16 <> "" Then
a.writeline ("<number type=" & """Feld6""" & " prio=" & """1""" & " id=" & """3""" & ">" + Feld16 + "</number>")
End If
If Feld17 <> "" Then
a.writeline ("<number type=" & """Feld6""" & " prio=" & """1""" & " id=" & """3""" & ">" + Feld17 + "</number>")
End If
If Feld18 <> "" Then
a.writeline ("<number type=" & """Feld6""" & " prio=" & """1""" & " id=" & """3""" & ">" + Feld18 + "</number>")
End If
If Feld19 <> "" Then
a.writeline ("<number type=" & """Feld6""" & " prio=" & """1""" & " id=" & """3""" & ">" + Feld19 + "</number>")
End If
If Feld20 <> "" Then
a.writeline ("<number type=" & """Feld6""" & " prio=" & """1""" & " id=" & """3""" & ">" + Feld20 + "</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
Mitglied: PeterleB
PeterleB 11.03.2022 um 13:48:56 Uhr
Goto Top
Hallo,

bitte solche Sachen in einen Codeblock setzen (vorletztes Zeichen in der Menüleiste).

Fehler:
If Feld1 <> "" Then  
a.writeline ("<number type=" & """HOME""" & " prio=" & """1""" & " id=" & """0""" & ">" + Feld1 + "</number>")  
End If
If Feld2 <> "" Then  
a.writeline ("<number type=" & """WORK""" & " prio=" & """1""" & " id=" & """1""" & ">" + Feld2 + "</number>")  
End If
If Feld3 <> "" Then  
a.writeline ("<number type=" & """MOBILE""" & " prio=" & """1""" & " id=" & """2""" & ">" + Feld3 + "</number>")  
End If
If Feld4 <> "" Then  
a.writeline ("<number type=" & """FAX_WORK""" & " prio=" & """1""" & " id=" & """3""" & ">" + Feld4 + "</number>")  
End If

Ansonsten kann ich Dein Ansinnen nicht ganz verstehen. Ich weiß nicht ob, die Fritz!Box etwas mit Deinen "Feld"-Bezeichnungen anfangen kann.

Gruß
Peter
Mitglied: PeterleB
PeterleB 11.03.2022 aktualisiert um 14:10:31 Uhr
Goto Top
Übrigens kannst Du in Deiner Variante 'ne ganze Menge Code sparen, in dem Du die Variablen dynamisch erzeugst.

Dim z As Long
Dim Feld(1 To 20) As String
For z = 1 To 20
     Feld(z) = ActiveCell.Offset(i, z)
Next

'Vertikale Spalte  
'Schreibt den Telefonbucheintrag  
a.writeline ("<contact><category>0</category>")  
a.writeline ("<person><realName>" + realName + "</realName></person><telephony>")  
For z = 1 To 20
   If Feld(z) <> "" Then  
   a.writeline ("<number type=" & """Feld(z)""" & " prio=" & """1""" & " id=" & """0""" & ">" + Feld(z) + "</number>")  
  End If
Next

a.writeline ("</telephony></contact>")  

Ob die 2. Schleife funktioniert, weiß ich jedoch nicht.
Gruß
Peter
Mitglied: Moreteen
Moreteen 11.03.2022 um 18:51:17 Uhr
Goto Top
Hallo Peter,
Du hast recht, "Feld1" u.s.w. schreibt die Fritzbox als "(sonstiges)".

Deine verkürzten Version von 14:10:31 Uhr:

Wenn ich in dieser zeile: "a.writeline ("<number type=" & """Feld(z)""" & " prio=" & """1""" & " id=" & """0""" & ">" + Feld(z) + "</number>")" statt "Feld" "home" eintrage kommt trotzdem "(sonstiges)".
Titel für die Ziffernblöcke die hier kommen sollten: "a.writeline ("<person><realName>" + realName + "</realName></person><telephony>")"
kommen gar nicht.


LG, Martin
Mitglied: Moreteen
Moreteen 11.03.2022 um 22:55:28 Uhr
Goto Top
Ok die Titel für die Ziffernblöcke kommen jetzt, Ich hatte eine Zeile vergessen.
Warum aber hinter den Telefonnummern "(sonstiges)" steht trotzdem ich "HOME" eingetragen habe verstehe ich nicht.
"For z = 1 To 20
If HOME(z) <> "" Then
a.writeline ("<number type=" & """HOME""" & " prio=" & """1""" & " id=" & """0""" & ">" + HOME(z) + "</number>")"

Gruß, Martin
Mitglied: PeterleB
PeterleB 13.03.2022 um 17:42:19 Uhr
Goto Top
Hi,
das mit den Schleifen klappt wahrscheinlich doch nicht.
Ich denke, alles was keinen vordefinierten Namen als Feld hat, benennt die FB einfach in "sonstiges" um.

Gruß
Peter
Mitglied: Moreteen
Moreteen 13.03.2022 um 18:54:02 Uhr
Goto Top
Hi,
ja das ist schade. Das ursprüngliche korrigierte Makro funktioniert ja.
Wer akzeptieren kann dass hinter jeder Nummer (sonstiges) steht und nicht (privat), (geschäftlich) u.s.w. kann ja dann die Kurze Version nehmen.
Vielleicht hat ja noch jemand eine Idee wie man bei der kurzen Version den Eintrag hinter den Nummern ändern kann.

LG, Martin.
Mitglied: ElbeAVMFritz
ElbeAVMFritz 15.09.2022 um 18:13:30 Uhr
Goto Top
Ich bedanke mich ganz, ganz herzlich bei PerterlB und silvereye für die tolle Anleitung. Hat bei mir sofort funktioniert. Bevor ich diese Anleitung im Netz gefunden habe, hatte ich mit dem Service von AVM telefoniert.
Der "kompetente" AVM Mitarbeiter wusste zunächst nicht einmal mit meinem Anliegen etwas anzufangen. Nach ca. 1/4 Std teilt er mir dann mit, dass AVM keine Lösung für dieses Anliegen anbietet. Aber er würde einen Verbesserungsvorschlag einreichen. Ich haben dann das Gespräch freundlich beendet. Ich bin von den Produkten von AVM begeistert. Ich habe Fritzboxen 7390, 7490 und 2x 7590, davon natürlich nur eine 7590 im Einsatz. Auch meine SmartHome Geräte und auch die Netzwerkwerweiterungen (Powerline sind von AVM).
Tolle Produkte!!! Aber der Support ist eine Katastophe. Wieso können "NICHT AVM ZUGEHÖRIGE" solch eine tolle Anweisung verfassen, aber AVN kann daraus kein Programm oder eine APP machen. . Nochmals herzlichen Dank an die kompetenen Verfasser der Anweisung.
Mitglied: ElbeAVMFritz
ElbeAVMFritz 15.09.2022 um 23:36:08 Uhr
Goto Top
Hallo PeterLeB, ich habe da noch ein, nur optisches, Problem mi der Benutzeroberfläche der FritzBox.
Wenn man die Benutzeroberfläche (über den Browser) aufruft, dann steht in der obersten Zeile das Modell
der verwendete Fritzbox. Meine Fritzbox hat aber einen Namen. Dieser Name wird angezeigt wenn man auf
die Fläche mit der Modellnummer klick. Kann man nicht einen Quellcode erstellen, der zuerst den Namen der Fritzbox zeigt und, bei Bedarf, durch klick auf die Fläche mit dem Namen der Fritzbox, dann die Modell Nr. anzeigt. Ich hoffe ich habe mich verständlich ausgedrückt.