Hallo,
ich bin dabei ein Script zu erstelle, welches Kontakte aus einer DB nach Exchange-Online überträgt.
Prinzipiell funktioniert es, aber ich denke, dass es etwas eleganter in Bezug auf die Zugriffe funktionieren sollte.
In der jetztigen Funktion prüfe ich jeden einzelnen Kontakt und lösche diesen.
Danach lese ich die verfügbaren Kontakte ein und übertrage jeden einzelnen Kontakt ins Postfach.
Da das schon ziemlich dauert nun die Frage, ob es nicht besser wäre
1. die Kontakte im Postfach zu filtern und diese auf "einen Rutsch" zu löschen (als Filterfeld habe ich das Feld "SpouseName" hergenommen und
2. ebenso eine neue Liste (z.b.: List (Of Contacts) o.ä. zu erzeugen und diese dann komplett abzuspeichern.
Leider weiß ich da nicht so recht weiter. Vielleicht hat jemend einen Tip?
Anbei die aktuelle Funktion:
Public Function fnSyncDBToExchange() As String
Dim datStart As Date = Now
Try
Dim userEditCounter As Integer = 0
Dim userCounter As Integer = 0
Dim userFailCount As Integer = 0
Dim contactCount As Integer = 0
Dim sumCounter As Integer = 0
Dim EWS As ExchangeService = New ExchangeService With {
.Credentials = New WebCredentials("admin@firma.onmicrosoft.com", "*****"),
.Url = New Uri("https://outlook.office365.com/EWS/Exchange.asmx")
}
Using db As New dbExchangeEntities
Dim USERS = From u In db.tbl_KONTAKTE
Where Not u.EXTERN = True And Not u.EMAIL Is Nothing
Select u
userCounter = USERS.Count
For Each USER In USERS
sumCounter += 1
Dim delCounter As Integer = 0
Dim addCounter As Integer = 0
Try
EWS.ImpersonatedUserId = New ImpersonatedUserId(ConnectingIdType.SmtpAddress, USER.EMAIL)
Dim contactFolder As ContactsFolder = ContactsFolder.Bind(EWS, WellKnownFolderName.Contacts)
contactCount = contactFolder.TotalCount
If contactCount > 0 Then
userEditCounter += 1
Dim view As ItemView = New ItemView(contactCount)
view.PropertySet = New PropertySet(BasePropertySet.IdOnly, ContactSchema.Profession, ContactSchema.DisplayName, ContactSchema.SpouseName)
Dim contactItems As FindItemsResults(Of Item) = EWS.FindItems(WellKnownFolderName.Contacts, view)
For Each item As Item In contactItems
If TypeOf item Is Contact Then
Dim contact As Contact = TryCast(item, Contact)
If contact.SpouseName = "CRIT" Then
delCounter += 1
item.Delete(DeleteMode.HardDelete)
End If
End If
Next
End If
Dim KONTAKTE = From k In db.tbl_KONTAKTE
Where Not k.EXTERN = True And Not k.EMAIL Is Nothing
Select k
For Each KONTAKT In KONTAKTE
Dim nKontakt As Contact = New Contact(EWS) With {
.DisplayName = KONTAKT.VORNAME & " " & KONTAKT.NACHNAME,
.CompanyName = KONTAKT.FIRMA,
.Surname = KONTAKT.NACHNAME,
.GivenName = KONTAKT.VORNAME,
.JobTitle = KONTAKT.POSITION,
.Manager = KONTAKT.VORGESETZTER,
.NickName = KONTAKT.KURZ,
.OfficeLocation = KONTAKT.STANDORT,
.SpouseName = "CRIT"
}
Dim adress As PhysicalAddressEntry = New PhysicalAddressEntry With {
.City = KONTAKT.ORT,
.CountryOrRegion = "Bayern",
.PostalCode = KONTAKT.PLZ,
.State = "DE",
.Street = KONTAKT.STRASSE
}
With nKontakt
.EmailAddresses.Item(EmailAddressKey.EmailAddress1) = KONTAKT.EMAIL
.Body = "imported by script"
.FileAs = KONTAKT.VORNAME & "_" & KONTAKT.NACHNAME & "_" & KONTAKT.KONTAKT_ID
.Initials = KONTAKT.KURZ
.Department = KONTAKT.ABTEILUNG
With .PhoneNumbers
.Item(PhoneNumberKey.BusinessFax) = KONTAKT.FAX
.Item(PhoneNumberKey.BusinessPhone) = KONTAKT.FESTNETZ
.Item(PhoneNumberKey.MobilePhone) = KONTAKT.MOBIL
.Item(PhoneNumberKey.OtherTelephone) = KONTAKT.TELEFON1
.Item(PhoneNumberKey.BusinessPhone2) = KONTAKT.TELEFON2
.Item(PhoneNumberKey.PrimaryPhone) = KONTAKT.TELEFON3
End With
.BusinessHomePage = KONTAKT.WEBSITE
.PhysicalAddresses.Item(PhysicalAddressKey.Business) = adress
End With
Dim Folder As FolderId = New FolderId(WellKnownFolderName.Contacts)
nKontakt.Save(Folder)
addCounter += 1
Next
SetText((userCounter + 1 - sumCounter) & ": " & USER.NACHNAME & ", " & USER.VORNAME & " (" & USER.EMAIL & "): Kontakte: " & contactCount & ", gelöscht: " & delCounter & ", hinzugefügt: " & addCounter)
Catch ex As Microsoft.Exchange.WebServices.Data.ServiceResponseException
If ex.ErrorCode = 304 Then
SetText("HINWEIS: " & USER.EMAIL & " - keine Mailbox")
userFailCount += 1
Else
SetText("FEHLER Zeile " & Err.Erl.ToString & ": " & USER.EMAIL & " - " & ex.Message)
userFailCount += 1
End If
Catch ex As Exception
SetText("FEHLER Zeile " & Err.Erl.ToString & ": " & USER.EMAIL & " - " & ex.Message)
End Try
Next
SetText("Postfächer gesamt: " & userCounter & ", bearbeitet: " & userEditCounter & " von " & sumCounter & " - Fehler: " & userFailCount)
End Using
Catch ex As Exception
Dim strErr As String = "<mdlSyncDB_Exchange.fnSyncDBToExchange> Fehler Zeile " & Err.Erl.ToString & ": " & ex.Message
If Not ex.InnerException Is Nothing Then strErr &= " - " & ex.InnerException.Message
SetText(strErr)
Finally
Dim datEnde As Date = Now
Dim dauer As TimeSpan = datEnde - datStart
SetText("Dauer: " & dauer.Minutes & "min " & dauer.Seconds & "s.")
End Try
End FunctionWarum ich nicht einfach vorhandene Kontakte aktualisiere?
Ich dachte, damit wäre ich um einiges schneller als immer erst zu prüfen, ob es den Kontakt noch oder noch nicht gibt. Deshalb alle durch das Script erstellten löschen und aus der DB neu aufbauen. Auch da bin ich für bessere Wege offen.
Vielen Dank.
Viele Grüße, Volker