Hallo,
was könnte ich im nächsten Quelltext machen, um das dbCurrent.Search weg zu bekommen, da dies sehr langsam ist.
Dieses Programm kopiert meine Ansicht aller Benutzer in die Ansicht der anderen Benutzer.
Sub Click(Source As Button)
On Error Goto errHandler
Const cProcedureName = {Verteile Buddy-Liste}
Dim sesCurrent As New NotesSession
Dim dbCurrent As NotesDatabase
Dim colTmp As NotesDocumentCollection
Dim docTmp As NotesDocument , docSource As NotesDocument
Dim strFormula As String, strFormula2 As String, strData As String, strFilePath As String, strField As String
Dim itemSource As NotesItem
Dim bytes As Variant
Dim nCounter As Long
Dim nFileHandle As Integer
Dim vntTmp As Variant
Dim strUser As String
Dim counter As Integer 'Zähler für Anzahl der Schleifendurchläufe
Dim returnMB As String 'Rückgabewert der Messagebox
strUser = sesCurrent.CommonUserName
strFormula = {Form="StorageAttributes" & @Name([CN]; storageuserid)<>"} & strUser & {"}
strFormula2 = {Form="StorageAttributes" & @Name([CN]; storageuserid)="} & strUser & {"}
Set dbCurrent = sesCurrent.CurrentDatabase
Set colTmp = dbCurrent.Search(strFormula, Nothing, 0) '
Set docSource = dbCurrent.Search(strFormula2, Nothing, 0).GetFirstDocument '
If (docSource Is Nothing) Then
Messagebox "Zu dem Benutzer " + strUser + " wurde keine Konfiguration zum verteilen gefunden", 16, "Fehler"
Exit Sub
End If
returnMB = Messagebox ("Sie sind als " + strUser + " angemeldet, wollen Sie ihre Dateien auf die anderen Rechner kopieren?" , 68 , "docSource") '36=4 YesNo, 32 Sprechblase
If (returnMB = 6 )Then 'Wenn Messagebox mit Ja beantwortet wird
Set itemSource = docSource.GetFirstItem("0")
Set docTmp = colTmp.GetFirstDocument
While Not(docTmp Is Nothing)
Call itemSource.CopyItemToDocument(docTmp, "0")
Call docTmp.Save(True, False, False)
counter = counter+1
Set docTmp = colTmp.GetNextDocument(docTmp)
Wend
End If
Messagebox "Das Dokument wurde an " + Cstr(counter) + " Personen weitergegeben.", 0, "" 'Anzahl an wieviel Dokument weitergeleitet wurde
Exit Sub
errHandler:
On Error Goto 0
Error Err, "Fehler in Funktion '" +cProcedureName + "' : " + Str(Err) + " (" + Error$ + ") in Zeile " + Str(Erl)
Resume errExit
errExit:
End Sub
