Excel Datei exportieren nach eine XML Datei

[FaDos]

Hallo,

ich brauche Hilfe bei einem Makro.

Button „OXA Telefonbuch exportieren“

Das Makro, soll aus der vorhanden Telefon liste eine XML Datei erzeugen, was unsere Telefonanlage Avaya lesen kann.
Bei den Spalten „Work“ soll wenn in Spalte „ID“ ein X steht keine „0“ vor gesetzt werden, wenn kein „X“ mit „0“ vor gesetzt werden.
Bei den Spalten „Mobile“ + „Home“ soll immer ein „0“ vor gesetzt werden.

Das Makro an sich funktioniert, wir brauchen nur eine Erweiterung.
Derzeit wird nur aus Excel „Nachname“ + „Vorname“ + „Work (Telefon-Büro)“ exportiert.
Wir brauchen aber jetzt zusätzlich noch „Mobile (Handy)“ + „Home (Privat)“ mit exportiert.

Doch ich verstehe den Makro nicht.   Kann da jemand helfen?

Danke schon mal im Voraus.


  Telefonbuch-Test.xlsm (Größe: 42,73 KB / Downloads: 14)

[FaDos]

Moin,
hat keine eine Idee?   Wie ich es ändern / Ergänzen kann?

Hallo,

ich brauche Hilfe bei einem Makro.

Button „OXA Telefonbuch exportieren“

Das Makro, soll aus der vorhanden Telefon liste eine XML Datei erzeugen, was unsere Telefonanlage Avaya lesen kann.
Bei den Spalten „Work“ soll wenn in Spalte „ID“ ein X steht keine „0“ vor gesetzt werden, wenn kein „X“ mit „0“ vor gesetzt werden.
Bei den Spalten „Mobile“ + „Home“ soll immer ein „0“ vor gesetzt werden.

Das Makro an sich funktioniert, wir brauchen nur eine Erweiterung.
Derzeit wird nur aus Excel „Nachname“ + „Vorname“ + „Work (Telefon-Büro)“ exportiert.
Wir brauchen aber jetzt zusätzlich noch „Mobile (Handy)“ + „Home (Privat)“ mit exportiert.

Doch ich verstehe den Makro nicht.   Kann da jemand helfen?

Danke schon mal im Voraus.

[Steffl]

Hallo,

meinst Du so?

Code:

Sub Excel2XML_exportieren()
 
 Dim fs, f, Tmp, retstring, fPfad, fDatei, RufNr
 Dim AnzKontakte As Integer, i As Integer
 
 Dim ZA1xml, ZA2xml, ZA3xml, ZA4xml, ZE1xml, ZE2xml, ZE3xml, ZE4xml
 
 Set ThisWB = ThisWorkbook
 Set wsInfo = ThisWB.Sheets("Info")
 Set wsData = ThisWB.Sheets("Telefonbuch")
 
 
 AnzKontakte = wsData.Range("AnzKontakte")
 
 If AnzKontakte > 0 Then
 
   Daten_bereinigen AnzKontakte
 
   ZA1xml = "<?xml version=" & Chr(34) & "1.0" & Chr(34) & " ?>"
   ZA2xml = "<ContactGroup xmlns:xsi=" & Chr(34) & "http://www.w3.org/2001/XMLSchema-instance" & Chr(34) & " xmlns:xsd=" & Chr(34) & "http://www.w3.org/2001/XMLSchema" & Chr(34) & " ReadOnly=" & Chr(34) & "false" & Chr(34) & " Type=" & Chr(34) & "User" & Chr(34) & " Version=" & Chr(34) & "2.0.09184.0" & Chr(34) & " xmlns=" & Chr(34) & "http://avaya.com/OneXAgent/ObjectModel/Contacts" & Chr(34) & ">"
   ZA3xml = "<Group ReadOnly=" & Chr(34) & "false" & Chr(34) & " Type=" & Chr(34) & "User" & Chr(34) & " Name=" & Chr(34) & "My Contacts" & Chr(34) & " Id=" & Chr(34) & "CT2:f369541a-2b91-420d-b5fd-8e413de16174" & Chr(34) & " Tag=" & Chr(34) & AnzKontakte & Chr(34) & ">"
   ZA4xml = "<Contacts ReadOnly=" & Chr(34) & "false" & Chr(34) & ">"
 
   ZE1xml = "</Contacts>"
   ZE2xml = "</Group>"
   ZE3xml = "<Contacts ReadOnly=" & Chr(34) & "false" & Chr(34) & " />"
   ZE4xml = "</ContactGroup>"

   fPfad = ThisWorkbook.Path & "\"
   fDatei = "Contacts.xml"
   Set fs = CreateObject("Scripting.FileSystemObject")
   Set f = fs.CreateTextFile(fPfad & fDatei, True, True)

   f.writeline (ZA1xml)
   f.writeline (ZA2xml)
   f.writeline (ZA3xml)
   f.writeline (ZA4xml)
 
  'Kontakte schreiben
 
   For i = 8 To AnzKontakte + 8
 
     Tmp = ""
     Tmp = "<Contact " & "Id=" & Chr(34) & "" & Chr(34) & " FirstName=" & Chr(34) & wsData.Cells(i, 5) & Chr(34) & " LastName=" & Chr(34) & wsData.Cells(i, 4) & Chr(34)
     If wsData.Cells(i, 2) = "" Then
       RufNr = "0" & wsData.Cells(i, 6)  ' mit VAz
     Else
       RufNr = wsData.Cells(i, 6)  ' Avaya-Nst
     End If
     Tmp = Tmp & " Work=" & Chr(34) & RufNr & Chr(34) & " Mobile=0" & wsData.Cells(i, 7) & Chr(34) & " Home=0" & wsData.Cells(i, 8) & Chr(34)
   
     Tmp = Tmp & " Favorite=" & Chr(34) & "false" & Chr(34) & " SpeedDial=" & Chr(34) & "false" & Chr(34) & " ReadOnly=" & Chr(34) & "false" & Chr(34) & ">"
   
     f.writeline (Tmp)
   
     Tmp = "<Address Address1=" & Chr(34) & wsData.Cells(i, 11) & Chr(34) & " Address2=" & Chr(34) & wsData.Cells(i, 12) & Chr(34) & " />"
     f.writeline (Tmp)
     Tmp = "<ClickToDial Work=" & Chr(34) & "false" & Chr(34) & " Mobile=" & Chr(34) & "false" & Chr(34) & " Home=" & Chr(34) & "false" & Chr(34) & " Video=" & Chr(34) & "false" & Chr(34) & " IM=" & Chr(34) & "false" & Chr(34) & " />"
     f.writeline (Tmp)
     Tmp = "</Contact>"
     f.writeline (Tmp)
 
   Next i
 
   f.writeline (ZE1xml)
   f.writeline (ZE2xml)
   f.writeline (ZE3xml)
   f.write (ZE4xml)
   f.Close
   
   Tmp = "Es wurden " & AnzKontakte & " Kontakte ins OXA-Telefonbuch exportiert." & Chr(13)
   Tmp = Tmp & "Die Kontakte liegen in <" & fDatei & "> im Pfad:" & Chr(13)
   Tmp = Tmp & fPfad & Chr(13) & Chr(13)
   Tmp = Tmp & "Bitte Datei in Ihr OXA-Verzeichnis kopieren:" & Chr(13)
   Tmp = Tmp & "D:\Dokumente und Einstellungen\<<Username>>\Anwendungsdaten\Avaya\one-X Agent\2.0\Profiles\default"
   
   MsgBox Tmp, vbDefaultButton1, "Info"
   
 Else
   MsgBox "Es sind keine Kontaktdaten vorhanden. Kein Export erfolgt.", vbDefaultButton1, "Info"
 End If
   
   
End Sub

[FaDos]

Hallo,

die XML Datei sieht gut aus, doch unsere Telefon Client erkennt die Datei nicht.

FaDos

[FaDos]

Hallo,

die XML Datei sieht gut aus, doch unsere Telefon Client erkennt die Datei nicht.

FaDos

Ein Fehler habe ich doch gefunden

Die Rufnummern müssen immer zwischen " xxx"  liegen.
Mobile="0177 11223344"  Home="095 123456"

Doch das Makro mach nur am ende ein "  und nicht am Anfang.

Betroffene bereich:      

Code:

Tmp = Tmp & " Work=" & Chr(34) & RufNr & Chr(34) & " Mobile=0" & wsData.Cells(i, 7) & Chr(34) & " Home=0" & wsData.Cells(i, 8) & Chr(34)

Kannst du bitte dies auch berücksichtigen.

Danke

[Steffl]

Hallo,

versuchs mal so

Code:

Tmp = Tmp & " Work=" & Chr(34) & RufNr & Chr(34) & " Mobile=" & chr(34) & "0" & wsData.Cells(i, 7) & Chr(34) & " Home=" & chr(34) & "0" & wsData.Cells(i, 8) & Chr(34)

[FaDos]

Hallo,

Danke für die Hilfe.

Nur noch eine kleinigkeit.

Die Spalte "C" gibt vor ob die Rufnummer "Work" eine interne oder Externe ist.
C = x => Intern ohne "0"
C = "leer" => Extern mit "0"

Kann man das auch berücksichtigen?

Danke

[Steffl]

Hallo,

ungetestet

Code:

Tmp = Tmp & " Work=" & Chr(34) & IIf(wsData.Cells(i, 3) = "x", "", "0") & RufNr & Chr(34) & " Mobile=" & Chr(34) & "0" & wsData.Cells(i, 7) & _
Chr(34) & " Home=" & Chr(34) & "0" & wsData.Cells(i, 8) & Chr(34)

[FaDos]

Hallo,

ungetestet

Code:

Tmp = Tmp & " Work=" & Chr(34) & IIf(wsData.Cells(i, 3) = "x", "", "0") & RufNr & Chr(34) & " Mobile=" & Chr(34) & "0" & wsData.Cells(i, 7) & _
Chr(34) & " Home=" & Chr(34) & "0" & wsData.Cells(i, 8) & Chr(34)

Leider nicht.
Jetzt wird mal 1er "0" mal 2 "0" eingefügt.

Siehe Bilder.

Danke

[Steffl]

Hallo,

meine Codeänderung an dieser Stelle war großer Mist :16: Etwas weiter oben war ja schon eine fast passende Konstellation vorhanden.

Code:

For i = 8 To AnzKontakte + 8
  
      Tmp = ""
      Tmp = "<Contact " & "Id=" & Chr(34) & "" & Chr(34) & " FirstName=" & Chr(34) & wsData.Cells(i, 5) & Chr(34) & " LastName=" & Chr(34) & wsData.Cells(i, 4) & Chr(34)
      'hier die 2 in eine 3 geändert
      If wsData.Cells(i, 3) = "" Then
        RufNr = "0" & wsData.Cells(i, 6)  ' mit VAz
      Else
        RufNr = wsData.Cells(i, 6)  ' Avaya-Nst
      End If
     'Tmp = Tmp & " Work=" & Chr(34) & RufNr & Chr(34)
     'Tmp = Tmp & " Work=" & Chr(34) & RufNr & Chr(34) & " Mobile=" & Chr(34) & "0" & wsData.Cells(i, 7) & Chr(34) & " Home=" & Chr(34) & "0" & wsData.Cells(i, 8) & Chr(34)
      Tmp = Tmp & " Work=" & Chr(34) & RufNr & Chr(34) & " Mobile=" & Chr(34) & "0" & wsData.Cells(i, 7) & _
      Chr(34) & " Home=" & Chr(34) & "0" & wsData.Cells(i, 8) & Chr(34)
      Tmp = Tmp & " Favorite=" & Chr(34) & "false" & Chr(34) & " SpeedDial=" & Chr(34) & "false" & Chr(34) & " ReadOnly=" & Chr(34) & "false" & Chr(34) & ">"
    
      f.writeline (Tmp)
    
      Tmp = "<Address Address1=" & Chr(34) & wsData.Cells(i, 11) & Chr(34) & " Address2=" & Chr(34) & wsData.Cells(i, 12) & Chr(34) & " />"
      f.writeline (Tmp)
      Tmp = "<ClickToDial Work=" & Chr(34) & "false" & Chr(34) & " Mobile=" & Chr(34) & "false" & Chr(34) & " Home=" & Chr(34) & "false" & Chr(34) & " Video=" & Chr(34) & "false" & Chr(34) & " IM=" & Chr(34) & "false" & Chr(34) & " />"
      f.writeline (Tmp)
      Tmp = "</Contact>"
      f.writeline (Tmp)
  
    Next i