23.08.2016, 12:11
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%.
Jetzt soll noch eine Weitere Spalte ( i ) dazu kommen, da ist dann die jeweilige eMail Adresse hinterlegt
Bis jetzt benutzen Code:
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.
[attachment=6663]
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 SubKann da jemand helfen? Bei der Erstellung diesen Code war "Steffl" sehr hilfreich, könnte er hier auch noch helfen.
Danke schon mal im Voraus.
[attachment=6663]