Domino 9 und frühere Versionen > ND6: Entwicklung
Variable mit einem Wert vergleichen
Manolo:
Wie versprochen mein Code:
Sub Click(Source As Button)
Dim ws As New notesuiworkspace
Dim session As New notessession
Dim uidoc As notesuidocument
Dim db1 As Notesdatabase
Dim db2 As Notesdatabase
Dim doc As notesdocument
Dim doc1 As notesdocument
Dim doc2 As notesdocument
Dim view2 As Notesview
Dim rtitem As NotesRichtextItem
Dim rtitem2 As NotesRichtextItem
Dim rtstyle As NotesRichtextStyle
Dim item As NotesItem
Dim IdxDbMax As Integer
Dim IdxDb As Integer
Dim PartNr As Long
Dim DatVon As Variant
Dim DatBis As Variant
Dim ReNr As Long
Dim StrPartNr As String
Dim StrDatVon As String
Dim StrDatBis As String
Dim StrClass As String
Dim StrKlasse As String
Dim StrType As String
Dim StrReNr As String
Dim StrName As String
Dim StrVorname As String
Dim content As String
Dim x As Integer
Dim AzDoc1 As Long
Dim AzDoc2 As Long
Dim BoxTitel As String
Dim xLng As Long
Dim xStr As String
Dim StrQuery As String
BoxTitel = "SearchFunktion"
Set uidoc = ws.currentdocument
Set doc = uidoc.Document
StrPartNr = doc.SearchPartnerNr(0)
StrDatVon = doc.SearchDocDatumVon(0)
StrDatBis = doc.SearchDocDatumBis(0)
StrClass = doc.SearchDocClass(0)
StrKlasse = doc.SearchDocKlasse(0)
StrType = doc.SearchDocType(0)
StrName = doc.SearchName(0)
StrVorname = doc.SearchVorname(0)
'--
'-- Partner Nummer
'--
If StrPartNr = "" Then Goto ErrPartnerNr
If Isnumeric(StrPartNr) Then
On Error Goto ErrPartNrOverflow
PartNr = Clng(StrPartNr)
On Error Goto errorX
If PartNr = 0 Then
Goto ErrPartNr0
End If
'-- ohne führende Nullen
StrPartNr = Cstr(PartNr)
Else
Goto ErrPartnerNr
End If
'--
'-- Doc Datum Von
'--
If StrDatVon <> "" Then
If Isdate(StrDatVon) Then
DatVon = Cdat(StrDatVon)
Else
Goto ErrDatumVon
End If
End If
'--
'-- Doc Datum Bis
'--
If StrDatBis <> "" Then
If Isdate(StrDatBis) Then
DatBis = Cdat(StrDatBis)
Else
Goto ErrDatumBis
End If
End If
'--
'--
'-- Tabelle abfüllen
'--
IdxDbMax = -1
Forall DbNameX In doc.DbName
IdxDbMax = IdxDbMax + 1
End Forall
'--
'-- open Db nach Doc.klasse
'--
IdxDb = 0
For x = 1 To IdxDbMax
If StrClass = doc.PartNrV(x) Then
idxDb = x
Exit For
End If
Next
'--
'-- set rtitem
'--
Set db1 = session.CurrentDatabase
Set doc1 = New notesdocument(db1)
Set rtstyle = session.CreateRichTextStyle
If (doc1.hasitem("Body")) Then
Set rtitem = doc1.getfirstitem("Body")
Else
Set rtitem = New notesrichtextitem(doc1, "Body")
End If
rtstyle.Bold = False
rtstyle.NotesColor = COLOR_BLACK
'rtstyle.NotesFont = FONT_HELV
rtstyle.Italic = False
Call rtitem.AppendStyle(rtstyle)
'--
'-- Search DB
'--
AzDoc1 = 0
AzDoc2 = 0
Set db2 = New notesdatabase(db1.server,doc.DbName(IdxDb))
Set view2 = db2.GetView(doc.ViewNameKey(0))
Set doc2 = view2.GetFirstDocument
Do While Not (doc2 Is Nothing)
'Set item = doc2.getfirstItem( "PMailingssearch" )
Print StrPartNr
If Instr(doc2.PMailingssearch(0),StrPartNr) > 0 Then
Goto Addtabelle
End If
Goto NextRead
'If Strleft(doc2.PMailingssearch(0), "$") = StrPartNr Then
' Goto Addtabelle
'End If
'-- add neues tabellen element
'--
Addtabelle:
AzDoc1 = AzDoc1 + 1
rtstyle.FontSize = 8
Call rtitem.AppendStyle(rtstyle)
Call rtitem.AppendDocLink(doc2,"")
Call rtitem.addtab(1)
If Isdate(doc2.Createdate(0)) Then
Call rtitem.appendtext(Left(Cstr(doc2.PDatum(0)), 10))
End If
Call rtitem.addtab(1)
'Call rtitem.AppendStyle(rtstyle)
'Call rtitem.appendtext(doc2.DocKlasse(0))
'Call rtitem.addtab(1)
Call rtitem.appendtext(doc2.DocType(0))
Call rtitem.addtab(1)
Call rtitem.appendtext(doc2.Title(0))
Call rtitem.addtab(1)
Call rtitem.appendtext(Cstr(doc2.RechnungsNr(0)))
Call rtitem.addnewline(2)
NextRead:
Set doc2 = view2.GetNextDocument(doc2)
Loop
'--
'-- Wurden Documente gefunden
'--
If AzDoc1 = 0 Then
Goto ErrNoDoc
End If
Call doc1.replaceitemvalue("Form","SearchResults")
'-
'- String Query abfüllen
'-
StrQuery = "Partner-Nr. = " & StrPartNr
If StrDatVon <> "" Then
StrQuery = StrQuery & ", Datum von = " & StrDatVon
End If
If StrDatBis <> "" Then
StrQuery = StrQuery & ", Datum bis = " & StrDatBis
End If
'If StrKlasse <> "" Then
' StrQuery = StrQuery & ", Dokument-Klasse = " & StrKlasse
'End If
If StrType <> "" Then
StrQuery = StrQuery & ", Dokument-Typ = " & StrType
End If
If StrReNr <> "" Then
StrQuery = StrQuery & ", Rechnungs-Nr. = " & StrReNr
End If
Call doc1.replaceitemvalue("Current", "Suchkriterien: " & StrQuery)
Call rtitem.CopyItemToDocument( doc1, "$$Body" )
Call ws.EditDocument(True, doc1)
Goto ende
ErrNoDoc:
StrQuery = "Unter dem Partner " & StrPartNr
If AzDoc2 > 0 Then
StrQuery = StrQuery & " und folgender Selektion:" & Chr$(13)
'If StrKlasse <> "" Then
' StrQuery = StrQuery & "Dokument-Klasse = " & StrKlasse & Chr$(13)
'End If
If StrType <> "" Then
StrQuery = StrQuery & "Dokument-Typ = " & StrType & Chr$(13)
End If
If StrReNr <> "" Then
StrQuery = StrQuery & "Rechnungs-Nr. = " & StrReNr & Chr$(13)
End If
If StrDatVon <> "" Then
StrQuery = StrQuery & "Datum von = " & StrDatVon & Chr$(13)
End If
If StrDatBis <> "" Then
StrQuery = StrQuery & "Datum bis = " & StrDatBis & Chr$(13)
End If
StrQuery = StrQuery & "wurden keine Dokumente gefunden."
StrQuery = StrQuery & Chr$(13) & " " & Chr$(13) & "Bitte andere Selektion wählen."
Else
StrQuery = StrQuery & " wurden keine Dokumente gefunden."
End If
Messagebox StrQuery,,BoxTitel
uidoc.gotoField("SearchPartnerNr")
Goto ende
ErrPartnerNr:
Messagebox "Eingabe PartnerNr nicht korrekt",,BoxTitel
uidoc.gotoField("SearchPartnerNr")
Goto ende
ErrPartNr0:
Messagebox "PartnerNummer 0 wird nicht verarbeitet",,BoxTitel
uidoc.gotoField("SearchPartnerNr")
Goto ende
ErrPartNrOverflow:
Messagebox "Zu hoher Wert für PartnerNummer, bitte kleineren Wert eingeben",,BoxTitel
uidoc.gotoField("SearchPartnerNr")
Resume ende
Goto ende
ErrDatumVon:
Messagebox "Eingabe Datum Von nicht korrekt",,BoxTitel
uidoc.gotoField("SearchDatumVon")
Goto ende
ErrDatumBis:
Messagebox "Eingabe Datum Bis nicht korrekt",,BoxTitel
uidoc.gotoField("SearchDatumBis")
Goto ende
ErrRechnungsNr:
Messagebox "Eingabe Rechnungs Nummer nicht korrekt",,BoxTitel
uidoc.gotoField("SearchDocRechnungsNr")
Goto ende
ErrReNrOverflow:
Messagebox "Zu hoher Wert für RechnungsNummer, bitte kleineren Wert eingeben",,BoxTitel
uidoc.gotoField("SearchDocRechnungsNr")
Resume ende
Goto ende
errorX:
Messagebox "Error" & Str(Err) & ": " & Error$,,BoxTitel
Goto ende
ende:
End Sub
koehlerbv:
Kann es sein, dass es sich bei Deinem PMailingssearch nicht um einen String, sondern ein String-Array handelt ?
Bernhard
Glombi:
Das habe ich mir auch überlegt. Evtl. ist PMailingssearch ein Feld mit Mehrfachwerten?
Falls ja, müsste man mit einer Forall-Schleife arbeiten.
Forall PMailingssearch in doc2.PMailingssearch
if instr(PMailingssearch,StrPartNr) > 0 then
... 'mit goto aus If und Forall (nicht die feine Art)
end if
end forall
Andreas
Manolo:
Hallo!!
Ich danke euch, ihr habt mir wirklich geholfen.
Der Code läuft, so geil.
Ich werde dann den fertigen code posten falls ihr ihn wollt.
Der Code ist für eine SearchDB in Domino Doc, das heisst er sucht mehrere DB's ab.
Also vielen Dank nochmals.
Navigation
[0] Themen-Index
[*] Vorherige Sete
Zur normalen Ansicht wechseln