Sub Click(Source As Button)
Dim session As New NotesSession
Dim ws As New NotesUIWorkspace
Dim db As NotesDatabase
Dim dc As NotesDocumentCollection
Dim doc As NotesDocument
Set db=session.CurrentDatabase
Set dc=db.unprocessedDocuments
Set doc=dc.GetFirstDOcument
Do While Not doc Is Nothing
Dim response As Variant
Dim response1 As Variant
Dim values(3) As Variant
values(0) = "vHa"
values(1) = "nHa"
values(2) = "vVe"
values(3) = "nVe"
Dim valuesA(4) As Variant
valuesA(0) = doc.vHa(0)
valuesA(1) = doc.vHa(1)
valuesA(2) = doc.vHa(2)
valuesA(3) = doc.vHa(3)
Dim valuesB(4) As Variant
valuesB(0) = doc.nHa(0)
valuesB(1) = doc.nHa(1)
valuesB(2) = doc.nHa(2)
valuesB(3) = doc.nHa(3)
Dim valuesC(4) As Variant
valuesC(0) = doc.vVe(0)
valuesC(1) = doc.vVe(1)
valuesC(2) = doc.vVe(2)
valuesC(3) = doc.vVe(3)
Dim valuesD(4) As Variant
valuesD(0) = doc.nVe(0)
valuesD(1) = doc.nVe(1)
valuesD(2) = doc.nVe(2)
valuesD(3) = doc.nVe(3)
response = ws.Prompt (PROMPT_OKCANCELCOMBO, _
"Servicezeit am " & doc.Datum(0) & ": ", "Bitte Funktion auswählen", values(0), values)
'Print response
If Isempty (response) Then
Messagebox "Abgebrochen", , "Nichts ausgewählt"
Else
If response = "vHa" Then
response1 = ws.Prompt (PROMPT_OKCANCELCOMBO, _
"Servicezeit am " & doc.Datum(0) & " " & response & ": ", _
"Bitte Mitarbeiter auswählen", valuesA(0), valuesA)
Elseif response = "nHa" Then
response1 = ws.Prompt (PROMPT_OKCANCELCOMBO, _
"Servicezeit am " & doc.Datum(0) & " " & response & ": ", _
"Bitte Mitarbeiter auswählen", valuesB(0), valuesB)
Elseif response = "vVe" Then
response1 = ws.Prompt (PROMPT_OKCANCELCOMBO, _
"Servicezeit am " & doc.Datum(0) & " " & response & ": ", _
"Bitte Mitarbeiter auswählen", valuesC(0), valuesC)
Elseif response = "nVe" Then
response1 = ws.Prompt (PROMPT_OKCANCELCOMBO, _
"Servicezeit am " & doc.Datum(0) & " " & response & ": ", _
"Bitte Mitarbeiter auswählen", valuesD(0), valuesD)
End If
Print response1
If Isempty (response1) Then
Messagebox "MA-Wahl abgebrochen", , "Nichts ausgewählt"
Else
Msgbox Left(response1,12), ,"SZ-Dok öffnen für " & doc.Datum(0) & " " & _
response
End If
End If
Set doc=dc.GetNextDocument(doc)
Loop
Call ws.ViewRefresh
End Sub
Sub Click(Source As Button)
Dim session As New NotesSession
Dim ws As New NotesUIWorkspace
Dim db As NotesDatabase
Dim dc As NotesDocumentCollection
Dim doc As NotesDocument
Set db=session.CurrentDatabase
Set dc=db.unprocessedDocuments
Set doc=dc.GetFirstDOcument
Dim response As Variant
Dim response1 As Variant
Dim values(3) As Variant
values(0) = "vHa"
values(1) = "nHa"
values(2) = "vVe"
values(3) = "nVe"
Do While Not doc Is Nothing
response = ws.Prompt (PROMPT_OKCANCELCOMBO, _
"Servicezeit am " & doc.Datum(0) & ": ", "Bitte Funktion auswählen", values(0), values)
'Print response
If Isempty (response) Then
Messagebox "Abgebrochen", , "Nichts ausgewählt"
Else
response1 = ws.Prompt (PROMPT_OKCANCELCOMBO, _
"Servicezeit am " & doc.Datum(0) & " " & response & ": ", _
"Bitte Mitarbeiter auswählen", doc.GetItemValues (response) (0), doc.GetItemValues (response))
Print response1
If Isempty (response1) Then
Messagebox "MA-Wahl abgebrochen", , "Nichts ausgewählt"
Else
Msgbox Left(response1,12), ,"SZ-Dok öffnen für " & doc.Datum(0) & " " & _
response
End If
End If
Set doc=dc.GetNextDocument(doc)
Loop
Call ws.ViewRefresh
End Sub...Redim Preserve.
Es geht natürlich auch einfacher: Statt Dim vValuesA (4) As Variant machst Du einfach nur ein Dim vValuesA As Variant und weisst dann das komplette Item zu:
vValuesA = doc.vHA
...
Sub Click(Source As Button)
Dim session As New NotesSession
Dim ws As New NotesUIWorkspace
Dim db As NotesDatabase
Dim dc As NotesDocumentCollection
Dim doc As NotesDocument
Dim response, response1 As Variant
Dim valuesA, valuesB, valuesC, valuesD As Variant
Dim values(3) As Variant
Set db=session.CurrentDatabase
Set dc=db.unprocessedDocuments
Set doc=dc.GetFirstDocument
values(0) = "vHa"
values(1) = "nHa"
values(2) = "vVe"
values(3) = "nVe"
Do While Not doc Is Nothing
valuesA = doc.vHa
valuesB = doc.nHa
valuesC = doc.vVe
valuesD = doc.nVe
response = ws.Prompt (PROMPT_OKCANCELCOMBO, _
"Servicezeit am " & doc.Datum(0) & ": ", "Bitte Funktion auswählen", values(0), values)
'Print response
If Isempty (response) Then
Messagebox "Abgebrochen", , "Nichts ausgewählt"
Else
If response = "vHa" Then
response1 = ws.Prompt (PROMPT_OKCANCELCOMBO, _
"Servicezeit am " & doc.Datum(0) & " " & response & ": ", _
"Bitte Mitarbeiter auswählen", valuesA(0), valuesA)
Elseif response = "nHa" Then
response1 = ws.Prompt (PROMPT_OKCANCELCOMBO, _
"Servicezeit am " & doc.Datum(0) & " " & response & ": ", _
"Bitte Mitarbeiter auswählen", valuesB(0), valuesB)
Elseif response = "vVe" Then
response1 = ws.Prompt (PROMPT_OKCANCELCOMBO, _
"Servicezeit am " & doc.Datum(0) & " " & response & ": ", _
"Bitte Mitarbeiter auswählen", valuesC(0), valuesC)
Elseif response = "nVe" Then
response1 = ws.Prompt (PROMPT_OKCANCELCOMBO, _
"Servicezeit am " & doc.Datum(0) & " " & response & ": ", _
"Bitte Mitarbeiter auswählen", valuesD(0), valuesD)
End If
Print response1
If Isempty (response1) Or response1 ="" Then
Messagebox "MA-Wahl abgebrochen", , "Nichts ausgewählt"
Else
Msgbox Left(response1,12), ,"SZ-Dok öffnen für " & doc.Datum(0) & " " & _
response
End If
End If
Set doc=dc.GetNextDocument(doc)
Loop
Call ws.ViewRefresh
End SubDu solltest auch versuchen, das Script allgemeingültiger zu schreiben, denn es hat viele Elemente unnötig mehrfach drin, die die Wartbarkeit erschweren und die Fehleranfälligkeit erhöhen...
response = ws.Prompt (PROMPT_OKCANCELCOMBO, _
"Servicezeit am " & doc.Datum(0) & ": ", "Bitte Funktion auswählen", NEWvalues(0), NEWvalues)
NEWvalues(0) = "vHa" & " - " & doc.GetItemValue("vHa")(0)
NEWvalues(1) = "vHa" & " - " & doc.GetItemValue("vHa")(1)
NEWvalues(2) = "vHa" & " - " & doc.GetItemValue("vHa")(2)
NEWvalues(3) = "vHa" & " - " & doc.GetItemValue("vHa")(3)
NEWvalues(4) = "nHa" & " - " & doc.GetItemValue("nHa")(0)
NEWvalues(5) = "nHa" & " - " & doc.GetItemValue("nHa")(1)
NEWvalues(6) = "nHa" & " - " & doc.GetItemValue("nHa")(2)
etc...
Dim values(3) As Variant
values(0) = "vHa"
values(1) = "nHa"
values(2) = "vVe"
values(3) = "nVe"
Dim NEWvalues As Variant
Dim count As Integer
Redim NEWvalues (15)
Forall v in values
Forall vv in doc.GetItemValue (v)
NEWvalues (count) = v & " - " & vv
count = count + 1
End Forall
End Forall
If count > 0 Then
Redim Preserve NEWvalues (count - 1)
End IfEtwa so...Wow!
Habe Dir in dem Script auch noch einiges an Optimierungspotential übrig gelassen.Ich finde ihn doch perfekt, ein Beispiel für Designer Hilfe! :)
Probier z.B. mal aus, was passiert, wenn eines der Felder leer istFunktioniert einwandfrei!
Sub Click(Source As Button)
'08.08.2012 Neu! Elegantere und sogar EINSTUFIGE Version !!!
Dim session As New NotesSession
Dim ws As New NotesUIWorkspace
Dim db As NotesDatabase
Dim dc As NotesDocumentCollection
Dim doc As NotesDocument
Dim response, response1 As Variant 'User zweimal fragen
Dim myKey As String 'Schlüssel für die Suche nach szDok
Dim view As NotesView
Dim entry As NotesViewEntry
Dim docEntry As NotesDocument
Set db=session.CurrentDatabase
Set dc=db.unprocessedDocuments
Set doc=dc.GetFirstDocument
Dim values(3) As Variant
values(0) = "vHa"
values(1) = "nHa"
values(2) = "vVe"
values(3) = "nVe"
'Variable Listen-Zuweisung
Dim NEWvalues As Variant
Dim count As Integer
'Redim NEWvalues (15) 'es könnten nicht nur 4x4 sondern 4x5 Einträge geben, daher unten ersetzt
Redim NEWvalues (19)
Forall v In values
Forall vv In doc.GetItemValue (v)
NEWvalues (count) = v & "-" & vv
count = count + 1
End Forall
End Forall
If count > 0 Then
Redim Preserve NEWvalues (count - 1)
End If
Do While Not doc Is Nothing
response = ws.Prompt (PROMPT_OKCANCELCOMBO, _
"Servicezeit am " & doc.Datum(0) & ": ", "Bitte Funktion auswählen", NEWvalues(0), NEWvalues)
If Isempty (response) Then
Messagebox "Abgebrochen", , "Nichts ausgewählt"
Exit Sub
Else
'Msgbox Left(Strleft(response1," - "),14), ,"SZ-Dok öffnen für " & doc.Datum(0) & _
'" " & response
myKey = doc.Datum(0) & "-" & Strleft(response," - ") 'neu
End If
'Das gesuchte szDok finden und öffnen
Set view = db.GetView("szCalendarVollAlle") 'alle szDoks
Call view.Refresh
Set entry = view.GetEntryByKey(MyKey, False) 'das gesuchte szDok finden
If entry Is Nothing Then
Msgbox "Leider nicht gefunden!",,myKey
Exit Sub
End If
Set docEntry = entry.Document 'vom gefundenen Entry zum eigenen Dokument wechseln
Call ws.EditDocument(True,docEntry) 'das gesuchte szDok ins Frontend überführen und öffnen
Set doc=dc.GetNextDocument(doc)
Loop
Call ws.ViewRefresh
Call view.Refresh
End Sub
Forall v In values
Forall vv In doc.GetItemValue (v)
If vv <> "" Then
NEWvalues (count) = v & "-" & vv
count = count + 1
End If
End Forall
End Forall
If count <= Ubound (NEWvalues) Then
If count = 0 Then
Msgbox "nix zu tun", 16, "Fehler"
Exit Sub
Else
Redim Preserve NEWvalues (count - 1)
End If
End If
1. Wenn z.B. vHa leer ist, bekommst Du in der Auswahlliste einen Eintrag "vHa -", deshalb sollte vv (also jeder einzelne Wert in den 4 Items) auf Inhalt überprüft werden.
2. Die Redim Preserve-Nummer am Ende war unsauber...Oh, nochmals vielen Dank!