Domino 9 und frühere Versionen > ND6: Entwicklung

Dublettenprüfung - Wie , Womit

<< < (2/2)

eknori:
na, dan mal her damit

Glombi:
Wenn Du kritikfähig bist, kannst Du es gerne posten.  ;)

Also, nur Mut und her damit.

Andreas

bikerboy:
Ach wie schnell das Wetter umschlagen kann , spätestens jetzt hättet ihr alles bekommen. Gerade lief es noch so wie es sollte und nun , wieder nur Kappes.

Gut fangen wir an :

Decleration :


--- Code: ---Dim session As NotesSession ' Die Session zum Arbeiten
Dim dbthis As NotesDatabase ' Die göffnete DB "preDocHouse"
Dim dbDocHouse As NotesDatabase ' Die "DocHouse"-Db
Dim docProfile As NotesDocument ' Beinhaltet das Profile-Dokument

Dim collection As NotesDocumentCollection ' Die NotesDocumentCollection aus dieser DB
Dim docCol As NotesDocument ' Die Dokumente aus der "preDocHouse"-DB
Dim isOpenFlag As Boolean ' Diese Flag zeigt an ob die DB geöfnet wurde
Dim i As Integer ' Der Zähler für die For-Schleife
Dim colSearch As NotesDocumentCollection ' Die NotesDocumentCollection für die Suche in der "DocHouse"DB
Dim docSearch As NotesDocument ' ein Dokument aus der colSearch
Dim strFieldname As String ' Feldname aus der DocHouseDB das untersucht werden soll
Dim strErgebnis As String ' String in dem die Suchergebnisse dargestellt werden
Dim searchField As String ' Das Feld in dem gesucht werden soll
Dim searchValue As String ' Der Suchtext für das zuvor deklarierte Feld
Dim colCount As Integer ' Beinhaltet die Azahl der Dokumente in der colSearch

Dim score As Double ' Beinhaltet den Scorewert
Dim key As String ' Beinhaltet das aktuelle Schlüsselfeld
Dim runFlag As Boolean ' Entscheidet darüber ob eine Prüfung läuft oder nicht
Dim forCollection As NotesDocumentCollection

Dim char As String
Dim char2 As String
Dim newString As String
Dim convChar As String



--- Ende Code ---

Initalize :


--- Code: ---Sub Initialize
Dim server As String
Dim database As String



Set session = New NotesSession ' Eröffnen der Session
Set dbthis = session.CurrentDatabase ' Initalisieren der aktuell geöffnetten DB

Set docProfile = dbthis.GetProfileDocument("Profile-Document")

server = Cstr(docProfile.GetItemValue("server")(0))
database = Cstr(docProfile.GetItemValue("database")(0))
Set dbDocHouse = session.GetDatabase(server,database)

If Not dbthis.IsOpen Then ' Prüfen ob die DB geöffnet wurde
Msgbox "Die Datenbank konnte nicht geöffnet werden ! "
End If

If Not dbDocHouse.IsOpen Then ' Prüfen ob die DocHouse DB geöffnet werden konnte
Msgbox "Die Datenbank (DocHouse) konnte nicht geöffnet werden ! "
End If

If Not dbDocHouse.IsFTIndexed Then
Call dbDocHouse.UpdateFTIndex(True)
End If

Call checker

End Sub

--- Ende Code ---

checker :


--- Code: ---Sub checker
Dim searchFormula As String
Dim searchFormula2 As String

searchFormula = {Form = "form"}
searchFormula2 = {status = 0}

Set collection = dbthis.search(searchFormula2, Nothing, 0)
Set colSearch  = dbDocHouse.Search(searchFormula,Nothing, 0)

If colSearch.count = 0 Then
Call CopyAgent
Exit Sub
End If
If colSearch.count = 0 Then
Msgbox "Fehler"
Exit Sub
End If
colCount = collection.Count

For i = 1 To  colCount
runflag = False
If i = 1 Then
Set docCol = collection.GetFirstDocument
Else
Set docCol = collection.GetNextDocument(docCol)
End If

If colSearch.Count  <> 0 Then
searchField = docProfile.GetItemValue("firstkey")(0)
searchValue =docCol.GetItemValue(searchField)(0)
Call colSearch.FTSearch(searchValue,0)
End If

If Not runflag = True Then
If colSearch.Count  > 1 Then
searchField = docProfile.GetItemValue("secondkey")(0)
searchValue =docCol.GetItemValue(searchField)(0)
Call colSearch.FTSearch(searchValue,0)
Elseif colSearch.count = 1 Then
Set docSearch = colSearch.GetFirstDocument
Call detailchecker
Elseif colSearch.Count = 0 Then
runflag = True
Call docCol.CopyToDatabase(dbDocHouse)
End If
End If

If Not runflag = True Then
If colSearch.Count > 1 Then
searchField = docProfile.GetItemValue("thirdkey")(0)
searchValue = docCol.GetItemValue(searchField)(0)
Call colSearch.FTSearch(searchValue,0)
Elseif colSearch.count = 1 Then
Set docSearch = colSearch.GetFirstDocument
Call detailchecker
Elseif colSearch.Count = 0 Then
If Not runflag = True Then
Call docCol.CopyToDatabase(dbDocHouse)
runflag = True
End If
End If
End If

If Not runflag = True Then
If colSearch.Count  > 1 Then
searchField = docProfile.GetItemValue("fourthkey")(0)
searchValue = docCol.GetItemValue(searchField)(0)
Call colSearch.FTSearch(searchValue,0)
Elseif colSearch.count = 1 Then
Set docSearch = colSearch.GetFirstDocument
Call detailchecker
Elseif colSearch.Count = 0 Then
If Not runflag = True Then
Call docCol.CopyToDatabase(dbDocHouse)
runflag = True
End If
End If
End If
If Not runflag = True Then
If colSearch.Count  > 1  Then
searchField = docProfile.GetItemValue("fithtkey")(0)
searchValue = docCol.GetItemValue(searchField)(0)
Call colSearch.FTSearch(searchValue,0)
Elseif colSearch.count = 1 Then
Set docSearch = colSearch.GetFirstDocument
Call detailchecker
Elseif colSearch.Count = 0 Then
If Not runflag = True Then
Call docCol.CopyToDatabase(dbDocHouse)
runflag = True
End If
End If
End If

If Not runflag = True Then
If colSearch.Count  > 1 Then
searchField = docProfile.GetItemValue("sixtkey")(0)
searchValue = docCol.GetItemValue(searchField)(0)
Call colSearch.FTSearch(searchValue,0)
Elseif colSearch.count = 1 Then
Set docSearch = colSearch.GetFirstDocument
Call detailchecker
Elseif colSearch.Count = 0 Then
If Not runflag = True Then
Call docCol.CopyToDatabase(dbDocHouse)
runflag = True
End If
End If
End If

Next

End Sub

--- Ende Code ---


detailchecker:


--- Code: ---Sub detailchecker

key = "secondkey"
If Not docProfile.getitemvalue(key)(0) = "" Then
searchField = docProfile.getitemvalue(key)(0)
If Not Isnumeric(docCol.GetItemValue(searchField)(0)) Then
If Roundex (Cstr(docCol.GetItemValue(searchField)(0))) = Roundex (Cstr(docSearch.GetItemValue(searchField)(0))) Then
score = score + 2
End If
Else
If Cstr(docCol.GetItemValue(searchField)(0)) = Cstr(docSearch.GetItemValue(searchField)(0)) Then
score = score + 2
End If
End If

End If

key = "thirdkey"
If Not docProfile.GetItemValue(key)(0) = "" Then
searchField = docProfile.GetItemValue(key)(0)
If Not Isnumeric(docCol.GetItemValue(searchField)(0)) Then
If Roundex (Cstr(docCol.GetItemValue(searchField)(0))) = Roundex (Cstr(docSearch.GetItemValue(searchField)(0))) Then
score = score + 1.5
End If
Else
If Cstr(docCol.GetItemValue(searchField)(0)) = Cstr(docSearch.GetItemValue(searchField)(0)) Then
score = score + 1.5
End If
End If
End If

key = "fourthkey"
If Not docProfile.GetItemValue(key)(0) = "" Then
searchField = docProfile.GetItemValue(key)(0)
If Not Isnumeric(docCol.GetItemValue(searchField)(0)) Then
If Roundex (Cstr(docCol.GetItemValue(searchField)(0))) = Roundex (Cstr(docSearch.GetItemValue(searchField)(0))) Then
score = score + 1
End If
Else
If Cstr(docCol.GetItemValue(searchField)(0)) = Cstr(docSearch.GetItemValue(searchField)(0)) Then
score = score + 1
End If
End If
End If

key = "fithtkey"
If Not docProfile.GetItemValue(key)(0) = "" Then
searchField = docProfile.GetItemValue(key)(0)
If Not Isnumeric(docCol.GetItemValue(searchField)(0)) Then
If Roundex (Cstr(docCol.GetItemValue(searchField)(0))) = Roundex (Cstr(docSearch.GetItemValue(searchField)(0))) Then
score = score + 1
End If
Else
If Cstr(docCol.GetItemValue(searchField)(0)) = Cstr(docSearch.GetItemValue(searchField)(0)) Then
score = score + 1
End If
End If
End If

key = "sixtkey"
If Not docProfile.GetItemValue(key)(0) = "" Then
searchField = docProfile.GetItemValue(key)(0)
If Not Isnumeric(docCol.GetItemValue(searchField)(0)) Then
If Roundex (Cstr(docCol.GetItemValue(searchField)(0))) = Roundex (Cstr(docSearch.GetItemValue(searchField)(0))) Then
score = score + 1
End If
Else
If Cstr(docCol.GetItemValue(searchField)(0)) = Cstr(docSearch.GetItemValue(searchField)(0)) Then
score = score + 1
End If
End If
End If

If score <= Cdbl(docProfile.GetItemValue("uncritical")(0)) Then
Call docCol.CopyToDatabase(dbDocHouse)
Elseif score <= Cdbl(docProfile.GetItemValue("critical")(0)) Then
Call docCol.ReplaceItemValue("score",score)
Call docCol.ReplaceItemValue("status","2")
Call docCol.Save(True, True)
Elseif score > Cdbl(docProfile.GetItemValue("verycritical")(0)) Then
Call docCol.ReplaceItemValue("score",score)
Call docCol.ReplaceItemValue("status","3")
Call docCol.Save(True,True)
End If
runflag = True

End Sub

--- Ende Code ---
Roundex:


--- Code: ---Sub detailchecker

key = "secondkey"
If Not docProfile.getitemvalue(key)(0) = "" Then
searchField = docProfile.getitemvalue(key)(0)
If Not Isnumeric(docCol.GetItemValue(searchField)(0)) Then
If Roundex (Cstr(docCol.GetItemValue(searchField)(0))) = Roundex (Cstr(docSearch.GetItemValue(searchField)(0))) Then
score = score + 2
End If
Else
If Cstr(docCol.GetItemValue(searchField)(0)) = Cstr(docSearch.GetItemValue(searchField)(0)) Then
score = score + 2
End If
End If

End If

key = "thirdkey"
If Not docProfile.GetItemValue(key)(0) = "" Then
searchField = docProfile.GetItemValue(key)(0)
If Not Isnumeric(docCol.GetItemValue(searchField)(0)) Then
If Roundex (Cstr(docCol.GetItemValue(searchField)(0))) = Roundex (Cstr(docSearch.GetItemValue(searchField)(0))) Then
score = score + 1.5
End If
Else
If Cstr(docCol.GetItemValue(searchField)(0)) = Cstr(docSearch.GetItemValue(searchField)(0)) Then
score = score + 1.5
End If
End If
End If

key = "fourthkey"
If Not docProfile.GetItemValue(key)(0) = "" Then
searchField = docProfile.GetItemValue(key)(0)
If Not Isnumeric(docCol.GetItemValue(searchField)(0)) Then
If Roundex (Cstr(docCol.GetItemValue(searchField)(0))) = Roundex (Cstr(docSearch.GetItemValue(searchField)(0))) Then
score = score + 1
End If
Else
If Cstr(docCol.GetItemValue(searchField)(0)) = Cstr(docSearch.GetItemValue(searchField)(0)) Then
score = score + 1
End If
End If
End If

key = "fithtkey"
If Not docProfile.GetItemValue(key)(0) = "" Then
searchField = docProfile.GetItemValue(key)(0)
If Not Isnumeric(docCol.GetItemValue(searchField)(0)) Then
If Roundex (Cstr(docCol.GetItemValue(searchField)(0))) = Roundex (Cstr(docSearch.GetItemValue(searchField)(0))) Then
score = score + 1
End If
Else
If Cstr(docCol.GetItemValue(searchField)(0)) = Cstr(docSearch.GetItemValue(searchField)(0)) Then
score = score + 1
End If
End If
End If

key = "sixtkey"
If Not docProfile.GetItemValue(key)(0) = "" Then
searchField = docProfile.GetItemValue(key)(0)
If Not Isnumeric(docCol.GetItemValue(searchField)(0)) Then
If Roundex (Cstr(docCol.GetItemValue(searchField)(0))) = Roundex (Cstr(docSearch.GetItemValue(searchField)(0))) Then
score = score + 1
End If
Else
If Cstr(docCol.GetItemValue(searchField)(0)) = Cstr(docSearch.GetItemValue(searchField)(0)) Then
score = score + 1
End If
End If
End If

If score <= Cdbl(docProfile.GetItemValue("uncritical")(0)) Then
Call docCol.CopyToDatabase(dbDocHouse)
Elseif score <= Cdbl(docProfile.GetItemValue("critical")(0)) Then
Call docCol.ReplaceItemValue("score",score)
Call docCol.ReplaceItemValue("status","2")
Call docCol.Save(True, True)
Elseif score > Cdbl(docProfile.GetItemValue("verycritical")(0)) Then
Call docCol.ReplaceItemValue("score",score)
Call docCol.ReplaceItemValue("status","3")
Call docCol.Save(True,True)
End If
runflag = True

End Sub

--- Ende Code ---


copyagent :


--- Code: ---Sub CopyAgent
For i = 1 To collection.Count
If i = 1 Then
Set docCol = collection.GetFirstDocument
Else
Set docCol = collection.GetNextDocument(docCol)
End If

Call docCol.CopyToDatabase(dBDocHouse)
Next
End Sub

--- Ende Code ---

bikerboy:
Habe den Fehler gefunden warum es bei einzelnen Suche funzt und sonst nicht.


Ich muss die Collection immer wieder naeuaufbauen und das habe ich nicht gemacht , er hat ja immer in der alten gesucht und ist klar dass er da nicht zu einem Ergebnis gekommen ist.

Navigation

[0] Themen-Index

[*] Vorherige Sete