Guten Morgen Notes-Spezies,
ich habe hier mal wieder ein großes Problem für uns (und wohl ein kleines für Euch):
Folgendes:
In einem Profildokument wird eine Funktion aufgerufen:
Unter Options haben wir folgenden Code:
Option Declare
Use "Lib1"
Unter QuerySave haben wir diesen Code:
Sub Querysave(Source As Notesuidocument, Continue As Variant)
'Ausschließliche Such im Feld Zieladresse
Call MailDBFind( Source.Document , "Zieladresse" )
'
'Suche in allen Namensfeldern
'Call AllPersItem( Source.Document )
' Cursor in freies Feld, um die Exit-Ereignisse der Namensfelder zu aktivieren
source.gotofield("Tage_bisArchivierung")
End Sub
In diesem Profildokument ist eine Teilmaske (Profil-Teilmaske) eingebettet:
In dieser Teilmaske befinden sich vier wichtige Felder:
Das Feld: "Zieladresse Valid"
Dieses ist mit dem Vorgabewert "0" gefüllt.
Das Feld: "Zieladresse"
Unter Options steht:
Use "Lib1"
Unter Declarations steht:
Dim uidoc As notesuidocument
Dim doc As notesdocument
Dim rc%
Unter Exiting steht:
Sub Exiting(Source As Field)
Dim workspace As New notesuiworkspace
Set uidoc = workspace.currentdocument
Set doc = uidoc.document
rc%=NamePruefen ("Zieladresse","Zieladresse_Aufloesung",1)
If rc%=0 Then
doc.Zieladresse_valid=1
Else
doc.Zieladresse_valid=0
End If
rc%= StellvertreterErmitteln ("Zieladresse_Aufloesung_Text","Zieladresse_Stellvertreter",1)
uidoc.refresh
End Sub
Das Feld "Zieladresse_Aufloesung"
Als Vorgabewert ist "" gesetzt
Das Feld "Zieladresse_Aufloesung_Text"
Als Vorgabewert ist folgende Formel eingetragen:
@Name([Abbreviate];Zieladresse_Aufloesung)
Das Feld "Zieladresse_Stellvertreter"
Das Vorgabefeld ist "" gesetzt
Die Script-Bibliothek ist folgende: "Lib1"
In dieser Script Bibliothek git es folgende Einträge:
(Option):
Option Public
Option Explicit
(Declarations):
Dim Session As Notessession
Dim Doc As NotesDocument
Dim Person As NotesDocument
Dim Adressbuch As NotesDatabase
Dim MailIN As NotesDatabase
Dim Item As NotesItem
Dim View As NotesView
Dim Server As String
Dim Token As Integer
Dim dbACL As NotesACL
Dim dbACLEntry As NotesACLEntry
Dim uidoc As notesuidocument
Dim Gruppe As notesdocument
Dim HilfsArray(), HilfsArray_aufgelöst(), DummyArray As Variant
Dim Fehlertext$
Dim Errorflag%
Dim rc% ' Antwort für msgbox
Dim i%,j%,t% ' Schleifenzähler
Dim z%,z_aufgelöst%,z_Dummy% ' Zähler für Hilfsarrays
Initialize:
Sub Initialize
Set Session = New Notessession
Server = Session.Currentdatabase.Server ' Den aktuellen Server ermitteln
Set Adressbuch = Session.GetDatabase( server , "Names.nsf" ) ' Das Adressbuch öffnen
Set View = Adressbuch.GetView( "($users)" ) ' Die entsprechende Ansicht öffnen
End Sub
Name Pruefen:
Function NamePruefen (Quellfeld As String, Zielfeld As String, KZ_zwingend As Integer) As Integer
' Diese Prozedur prüft im übergebenen Quellfeld, ob die darin befindlichen Namen im Namensadressbuch
' gespeichert sind.
' Wird die Adresse gefunden, wird der vollständige Name eingetragen, andernfalls
' eine Fehlermeldung ausgegeben und, falls das KZ_zwingend 1 (zwingende Gültigkeit) enthält, der Cursor zurück auf das fehlerhafte Quellfeld
' gestellt. Enthält das Kennzeichen 0 (Hinweis auf Gültigkeit), erfolgt eine Abfrage, ob der Name akzeptiert oder überarbeitet werden soll
'
' Übergabeparameter:
' Quellfeld: das zu prüfende Namensfeld (einfach oder mehrfach belegt)
' Zielfeld: Namensfeld, in das die aufgelösten Namen eingetragen werden (kann gleich dem Qellfeld sein)
' KZ_zwingend: KZ, ob bei nicht gefunden Namen Fehler oder Hinweismeldung angezeigt wird.
Dim workspace As New notesuiworkspace
Dim uidoc As notesuidocument
Dim Gruppe As notesdocument
Dim HilfsArray(), HilfsArray_aufgelöst(), DummyArray As Variant
Dim Fehlertext$
Dim Errorflag%
Dim rc% ' Antwort für msgbox
Dim i%,j%,t% ' Schleifenzähler
Dim z%,z_aufgelöst%,z_Dummy% ' Zähler für Hilfsarrays
Set uidoc = workspace.currentdocument
Set doc = uidoc.document
' Anfangswertzuweisungen
Errorflag%=False
z%= 0
z_aufgelöst%=0
z_Dummy%=0
'Hilfsarray auf die Grenzen des Quellfeldes setzen (getitemvalue liefert Array zurück)
Redim HilfsArray(Ubound(doc.getitemvalue(Quellfeld)))
Redim HilfsArray_aufgelöst(Ubound(doc.getitemvalue(Quellfeld)))
Redim DummyArray(Ubound(doc.getitemvalue(Quellfeld)))
'
' Ermitteln der echten Namen
'
Forall dummy In doc.getitemvalue(Quellfeld)
If dummy<>"" Then
Set Person = Nothing
Set Person = View.GetDocumentByKey(dummy, True )
If Not Person Is Nothing Then ' War die Suche erfolgreich
Select Case Person.form(0) ' Prüfung auf Gruppenbriefkasten oder Person
'--- Mail-IN-Datenbank
Case "Database" ' bei Mail-IN-Datenbank Ermittlung der Mitglieder
HilfsArray(z%)=Person.fullname(0)
rc%=GruppeAufloesen ("°MF_"+person.fullname(0),z_aufgelöst%,HilfsArray_aufgelöst)
'--- Gruppe
Case "Group" ' bei Gruppe Übertragung der Gruppenmitglieder ins angepasste Hilfsarray
HilfsArray(z%)=Person.listname(0)
For j%=0 To Ubound(person.members) ' Memberliste in Personen auflösen
rc%=GruppeAufloesen (person.members(j%),z_aufgelöst%,HilfsArray_aufgelöst)
Next
'--- Person
Case "Person" ' bei Person Übertragung der Person ins Hilfsarray
HilfsArray(z%)=Person.owner(0)
HilfsArray_aufgelöst(z_aufgelöst%)=Person.owner(0)
z_aufgelöst%=z_aufgelöst%+1
End Select
z%=z%+1
Else ' bei Fehler Zusammenstellung des Fehlertextes
DummyArray(z_Dummy%)=dummy
z_Dummy%=z_Dummy%+1
Fehlertext$=Fehlertext$+ dummy+Chr$(10)
Errorflag%=True
End If
' z%=z%+1
End If
End Forall
'
' Bei Fehlermeldung Prüfung auf Akzeptanz fehlerhafter Werte
'
If Errorflag%=True Then
If KZ_zwingend=1 Then 'zwingende Gültigkeit des Namens
Msgbox "Für folgende Namen existiert kein Eintrag im Namensadressbuch:"+Chr$(10)+Fehlertext$+"Bitte korrigieren Sie die Eingabe",32,"Ungültige(r) Name(n)"
uidoc.gotofield(Quellfeld)
uidoc.selectall
Else 'nicht zwingende Gültigkeit des Namens
' Msgbox "Folgende Namen werden ignoriert, da hierfür kein Eintrag im Namensadressbuch existiert:"+Chr$(10)+Fehlertext$,32,"Unbekannte(r) Name(n)"
rc%=Msgbox ( "Für folgende Namen existiert kein Eintrag im Namensadressbuch:"+Chr$(10)+Fehlertext$+Chr$(10)+"Sollen diese Namen trotzdem übernommen werden?",4+32,"Unbekannte(r) Name(n)")
If rc%=6 Then 'bestehende eigentlich falsche Namen sollen erhalten bleiben
For i%=0 To z_dummy%-1
HilfsArray(z%)=DummyArray(i%)
HilfsArray_aufgelöst(z_aufgelöst%)=DummyArray(i%)
z%=z%+1
z_aufgelöst%=z_aufgelöst%+1
Next i%
End If
Errorflag%=False
End If
End If
If Errorflag%=False Then
Set item = doc.replaceitemvalue(Quellfeld,HilfsArray )
If Zielfeld<>"" Then ' Füllen des Zielfeldes mit aufgelösten Namen, wenn Zielfeld angegeben
Set item = doc.replaceitemvalue(Zielfeld,HilfsArray_aufgelöst)
End If
uidoc.refresh ' Aktualisierung der Felder für abhängig berechnete Namensfelder
End If
NamePruefen=Errorflag% ' Returnwert der Funktion
End Function
Stellvertreter ermitteln: (HIER KOMMT DAS EIGENTLICHE PROBLEM)
Dim workspace As New NotesUIWorkspace
Dim uidoc As notesuidocument
Dim session As New NotesSession
Dim books As Variant
Dim view As NotesView
Dim doc As NotesDocument
Dim actdoc As notesdocument
' Dim item As notesitem
Dim person As Variant
Dim done As Variant
Dim test As Variant
Dim Stellvertreter As Variant
Dim person0 As Variant
Dim person1 As Variant
Dim Statusanzeige As Variant
Dim HugoErna As Variant
Dim Errorflag%
books = session.AddressBooks
done = False
Set uidoc = workspace.currentdocument
Set doc = uidoc.document
' Msgbox Statusanzeige & "Status = 1"
Set actdoc =uidoc.document
' person1 = Evaluate(|@Name([Abbreviate];@UserName)|)
' person1 = uidoc.fieldgettext("Quellfeld")
Msgbox "Test"
Forall dummy In doc.getitemvalue(Quellfeld)
Msgbox dummy
Set Person = Nothing
Person= dummy
' person1 = Evaluate(|@Name([Abbreviate];@UserName)|)
' Msgbox Quellfeld
' person1 = Evaluate(|@Name([Abbreviate];dummy)|)
Msgbox person &"Formel"
Forall b In books
' check every Domino Directory,
' unless we're already done
If ( b.IsPublicAddressBook ) And ( Not done ) Then
Call b.Open( "", "" )
Set view = b.GetView( "($VIMPeople)" )
Set doc = View.GetDocumentByKey(person, True )
' Msgbox "Test1"
' Msgbox Person1(0) & "Herausgelesen"
' person = person1(0)
If Not ( doc Is Nothing ) Then
done = True
If doc.Stellvertreter(0)="" Then
Msgbox "Feld Stellvertreter ist nicht gefüllt"
Msgbox doc.Stellvertreter(0)
Else
Msgbox "Feld Stellvertreter ist gefüllt"
Msgbox doc.Stellvertreter(0)
' Call uidoc.fieldsettext("HugoErna","Hallo")
' Set item = doc.replaceitemvalue("Zieladresse_Stellvertreter",doc.Stellvertreter(0))
' Msgbox actdoc.HugoErna(0)
' uidoc.refresh
' Zielfeld=doc.Stellverteter(0)
Set item = doc.replaceitemvalue(Zielfeld,doc.Stellvertreter(0))
' Set item = doc.replaceitemvalue(Zielfeld,doc.Zieladresse_Stellvertreter(0))
' Msgbox doc.Zieladresse_Stellvertreter(0) & "Erna"
Zielfeld = doc.Zieladresse_Stellvertreter(0)
uidoc.refresh
Msgbox Zielfeld & "Zielfeld"
End If
Else
Msgbox "nicht gefunden"
End If
End If
End Forall
End Forall
' if done is still False, the person wasn't found
If Not done Then
Messagebox _
( "Sorry, unable to locate person's name." )
End If
StellvertreterErmitteln=Errorflag%
End Function
Das eigentliche Problem ist, dass das Feld "Zieladresse" gefüllt ist, die Zeile Msgbox Zielfeld & "Zielfeld"
gibt den Inhalt des Zielfeldes wieder.
Leider werden die Werte nicht aus der Funktion ist das Feld "Zieladresse_Stellvertreter" geschrieben.
Woran kann das liegen. Wir haben schon eine Menge probiert, aber der Wert wird einfach nicht zurückgegeben.
Wäre super, wenn Ihr uns weiterhelfen könntet.
Vielen Dank
Marshuhn
Thema: Ein Wert wird über eine Funktion nicht zurückgegeben (Gelesen 1678 mal)