response = ws.Prompt (PROMPT_OKCANCELLIST, _
"Haupt Kategorie", _
"Bitte eine Haupt Kategorie auswählen.", _
"", Arrayunique(liste))
Sub Postopen2(Source As Notesuidocument)
Dim se As New NotesSession
Dim ws As New NotesUIWorkspace
Dim db As NotesDatabase
Dim viewOfen As NotesView
Dim viewMaschGruppe As NotesView
Dim viewFelderLookup As NotesView
Dim doc As NotesDocument
Dim docOfen As NotesDocument
Dim docMaschGruppe As NotesDocument
Dim docFelderLookup As NotesDocument
Dim listeOfen As Variant
Dim response As Variant
If source.IsNewDoc Then
Set db = se.CurrentDatabase
Set viewOfen = db.GetView("vwHauptKatColumn")
Set viewMaschGruppe = db.GetView("vwUnterKatLookup")
Set viewFelderLookup = db.GetView("vwFelderLookup")
Set doc = source.document
'Set docOfen = viewOfen.
'Redim listeOfen(0) As Variant
listeOfen = DBColumn(db.Server, db.FilePath, viewOfen.Name, 1)
response = ws.Prompt (PROMPT_OKCANCELLIST, _
"Haupt Kategorie", _
"Bitte eine Haupt Kategorie auswählen.", _
"", Arrayunique(listeOfen))
If Isempty(response) Then
Call Source.Close(True)
Exit Sub
End If
listeMaschGruppe = DBLookup(db.Server, db.FilePath, viewMaschGruppe.name, Cstr(response), 2)
response2 = ws.Prompt (PROMPT_OKCANCELLIST, _
"Unter Kategorie", _
"Bitte eine Unter Kategorie auswählen.", _
"", listeMaschGruppe)
If Isempty(response2) Then
Call Source.Close(True)
Exit Sub
End If
Call source.Document.ReplaceItemValue("HauptKat",response)
Call source.Document.ReplaceItemValue("UnterKat",response2)
Set docFelderLookup = viewFelderLookup.GetDocumentByKey(Trim(response+response2))
If Not docFelderLookup Is Nothing Then
Call docFelderLookup.CopyAllItems( source.Document, True )
doc.Form = "frmOpenPoint"
End If
Call Source.RefreshHideFormulas
Call Source.Refresh
Print Source.IsNewDoc
'Set doc = Nothing
Set docFelderLookup = Nothing
'Set doc = Source.Document
Dim unid As String
unid = Source.Document.UniversalID
Source.Document.SaveOptions = "0"
Call Source.Close(True)
'Set Source= Nothing
Call ws.EditDocument(True, doc)
Source.Document.SaveOptions = "1"
End If
Source.Document.SaveOptions = "1"
End Sub
Function DBColumn(strServerName As String, strDatabase As String, strViewName As String, intColumnNumber As Integer) As Variant
Dim NoCache As String
Dim NotesMacro As String
Dim Database As String
Dim serverName As NotesName
Set serverName = New NotesName(strServerName)
NoCache = Chr(34) + Chr(34) + ":" + Chr(34) + "NoCache" + Chr(34)
Database = Chr(34) + ReplaceSubstring(strDatabase,"\","\\") + Chr(34)
NotesMacro = "@DbColumn(" + NoCache + ";" + Chr(34) + serverName.Abbreviated + Chr(34) + ":" + Database + ";" +_
Chr(34) + strViewName + Chr(34) + ";" + Trim(Str(intColumnNumber)) + ")"
DBColumn = Evaluate(NotesMacro)
End Function
Function ReplaceSubstring(strSourceText As String, strSearchText As String, strReplaceText As String) As String
Dim strNewText As String
Dim pos As Integer
Dim inc As Integer
pos = 0
strNewText = strSourceText
If strReplaceText <> "" Then
inc = Len(strReplaceText)
Else
inc = 1
End If
pos = Instr(1, strNewText, strSearchText)
While pos <> 0
strNewText = Mid$(strNewText, 1, pos - 1) & strReplaceText & Mid$(strNewText, (Len(strSearchText) + pos))
pos = Instr(pos + inc, strNewText, strSearchText)
Wend
ReplaceSubstring = strNewText
End Function
Function DBLookup(strServerName As String, strDatabase As String, strViewName As String, strKey As String, intColumnNumber As Integer) As Variant
Dim NoCache As String
Dim NotesMacro As String
Dim UniqueNotesMacro As String
Dim Database As String
Dim serverName As NotesName
Set serverName = New NotesName(strServerName)
NoCache = Chr(34) + Chr(34) + ":" + Chr(34) + "NoCache" + Chr(34)
Database = Chr(34) + ReplaceSubstring(strDatabase,"\","\\") + Chr(34)
NotesMacro = "@DbLookup(" + NoCache + ";"+ Chr(34) + serverName.Abbreviated + Chr(34) + ":" + Database + ";" +_
Chr(34) + strViewName + Chr(34) + ";" + Chr(34) + strKey + Chr(34) + ";" + Trim(Str(intColumnNumber)) + ")"
DBLookup = Evaluate(NotesMacro)
End Function
...
response = ws.Prompt (PROMPT_OKCANCELLIST, "Haupt Kategorie", "Bitte eine Haupt Kategorie auswählen.", _
"", var)
->
...
response = ws.Prompt (PROMPT_OKCANCELLIST, "Haupt Kategorie", "Bitte eine Haupt Kategorie auswählen.", _
"", arr)