Excel Datei exportieren zu einer XML Datei

[FaDos]

Hallo,

ich brauche Erweiterte Hilfe bei einem Makro.

Das Makro, soll aus der vorhanden Telefon liste eine XML Datei, was unsere Telefonanlage Avaya lesen kann, erzeugen.

Folgende Spalten werden schon zu 100% erzeugt, und Funktionieren auch zu 100%.

• LastName
  
• FirstName
  
• Work
  
• Mobile
  
• Home
  

Jetzt soll noch eine Weitere Spalte ( i ) dazu kommen, da ist dann die jeweilige eMail Adresse hinterlegt  

Bis jetzt benutzen Code:

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 + 7

    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, 3) = "" Then
      RufNr = IIf(IsEmpty(wsData.Cells(i, 6)), "", "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=" & Chr(34) & IIf(IsEmpty(wsData.Cells(i, 7)), "", "0" & wsData.Cells(i, 7)) & Chr(34) & " Home=" & Chr(34) & IIf(IsEmpty(wsData.Cells(i, 8)), "", "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

Kann da jemand helfen?  Bei der Erstellung diesen Code war "Steffl" sehr hilfreich, könnte er hier auch noch helfen.

Danke schon mal im Voraus.


  Telefonbuch-Test.xlsm (Größe: 40,1 KB / Downloads: 4)

[schauan]

Hallöchen,

wenn das nur in der Zeile mit Vor- und Nachnamen usw. erscheinen soll, dann kann man das noch hinten dran setzen:

Code:

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) & " E-Mail=" & Chr(34) & wsData.Cells(i, 9) & Chr(34)

[FaDos]

Hallo Schauan,

nein, die eMail Adresse soll im Richtigen Feld für die Emails gespeichert werden.

siehe Bild


Danke
FaDos

[schauan]

Hallöchen,

ich meinte in der XML. Was Du im Bild hast, ist keine XML.

[FaDos]

Super

Danke