Habe jetzt einfach mal den gesamten Agent eingefügt, vielleicht ist es dann einfacher. Danke
'Send Newsletters | Send Newsletters:
Use "wStringResource"
'Send Newsletters | Send Newsletters:
Dim s As NotesSession
Dim db As NotesDatabase
Dim view As NotesView
Dim note As NotesDocument
Dim profile As NotesDocument
Dim newnote As NotesDocument
Dim newsletter As NotesNewsLetter
Dim collection As NotesDocumentCollection
Dim pPersonName As Variant
Dim pCategories As Variant
Dim pEvents As Variant
Dim pAuthors As Variant
Dim pStrings As Variant
Dim pMyName As Variant
Dim pThreads As Variant
Dim searchtype As String
Dim query As String
Dim textlist As String
Dim totalquery As String
Dim failed As Integer
Dim abrAltFrom As Variant
Sub Initialize
On Error Goto ErrorCleanup
Set s = New NotesSession
Set db = s.CurrentDatabase
Set view = db.GetView("($Profiles)")
Set profile = view.GetFirstDocument
If profile Is Nothing Then Exit Sub
Failed = False
FormName = profile.Form
If FormName(0) <> "Interest Profile" Then Set profile = view.GetNextDocument(profile)
Do Until profile Is Nothing
FormName = profile.Form
pPersonName = profile.PersonName
pSendTo = profile.FullPersonName
pCategories = profile.ProfileCategories
' pEvents = profile.ProfileEvents
pAuthors = profile.ProfileAuthors
pStrings = profile.ProfileStrings
pMyName = profile.ProfileMyName
pThreads = profile.ProfileThreads
If pCategories(0) = "" And pAuthors(0) = "" And pStrings(0) = "" And pMyName(0) = "" And pThreads(0) = "" Then
'if all the fields are blank, don't bother to search
Else
If db.IsFTIndexed = True Then
DoFTSearch
Else
DoFormulaSearch
End If
If collection.Count > 0 Then
Set newsletter = New NotesNewsletter(collection)
newsletter.DoSubject = True
newsletter.SubjectItemName = "NewsLetterSubject"
Set newnote = newsletter.FormatMsgWithDoclinks(db)
newnote.Form = "Memo"
newnote.SendTo = pPersonName(0)
newnote.SendTo = pSendTo(0)
newnote.Subject = getstring(33) & db.Title
newnote.Send False
End If
End If
ErrorReset:
Set profile = view.GetNextDocument(profile)
Loop
Exit Sub
ErrorCleanup:
If Err = 4294 Or Err = 4295 Then
Goto ErrorReset
Else
Failed = True
Exit Sub
End If
End Sub
Sub DoFTSearch
searchtype = "FT"
totalquery = ""
Forall n In pCategories
BuildTextList(n)
End Forall
If textlist <> "" Then
query = "field Categories contains (" & textlist & ")"
BuildTotalQuery
End If
Forall n In pAuthors
BuildTextList(n)
If textlist <> "" Then
query = "field AbbreviateFrom contains " & textlist & " Or field AltFrom contains " & textlist
BuildTotalQuery
End If
End Forall
Forall n In pStrings
BuildTextList(n)
End Forall
If pMyName(0) <> "" Then
Forall n In pPersonName
BuildTextList(n)
End Forall
End If
If textlist <> "" Then
query = "field Body contains (" & textlist & ") or field Subject contains (" & textlist & ")"
BuildTotalQuery
End If
Forall n In pThreads
BuildTextList(n)
End Forall
If textlist <> "" Then
query = "field ThreadId contains (" & textlist & ")"
BuildTotalQuery
End If
totalquery = totalquery & " and (not(field form contains log, profile))"
Set collection = db.UnprocessedFTSearch(totalquery, 0)
End Sub
Sub DoFormulaSearch
searchtype = "Formula"
totalquery = ""
If pCategories(0) <> "" Then
Forall n In pCategories
BuildTextList(n)
End Forall
If textlist <> "" Then
query = "(@Contains(@UpperCase(Categories); @UpperCase(" & textlist &_
")) | @AllDescendants)"
BuildTotalQuery
End If
End If
If pAuthors(0) <> "" Then
Forall n In pAuthors
BuildTextList(n)
End Forall
If textlist <> "" Then
query = "@Contains(@UpperCase(AbbreviateFrom); @UpperCase(" & textlist & ")) | @Contains(@UpperCase(AltFrom); @UpperCase(" & textlist & "))"
BuildTotalQuery
End If
End If
If pStrings(0) <> "" Then
Forall n In pStrings
BuildTextList(n)
End Forall
If textlist <> "" Then
query = "@Contains(@UpperCase(Body); @UpperCase(" & textlist &_
")) | @Contains(@UpperCase(Subject); @UpperCase(" & textlist & "))"
BuildTotalQuery
End If
End If
If pMyName(0) <> "" Then
query = "@Contains(@UpperCase(Body); @UpperCase(" & """" & pPersonName(0) & """" &_
")) | @Contains(@UpperCase(Subject); @UpperCase(" & """" & pPersonName(0) & """" & "))"
BuildTotalQuery
End If
If pThreads(0) <> "" Then
Forall n In pThreads
BuildTextList(n)
End Forall
If textlist <> "" Then
query = "@Contains(@UpperCase(ThreadId); @UpperCase(" & textlist & "))"
BuildTotalQuery
End If
End If
totalquery = totalquery & " & @isavailable(NewsletterSubject) & (!@Contains(Form; ""Log"" : ""Profile"")) & (readers = """")"
Set collection = db.UnprocessedSearch(totalquery, Nothing, 0)
End Sub
Sub BuildTextList(n As Variant)
If searchtype = "FT" Then
If textlist = "" Then
textlist = n
Else
textlist = textlist & ", " & n
End If
Else
nvalue = """" & n & """"
If textlist = "" Then
textlist = nvalue
Else
textlist = textlist & " : " & nvalue
End If
End If
End Sub
Sub BuildTotalQuery
If totalquery = "" Then
totalquery = query
Else
If searchtype = "FT" Then
totalquery = totalquery & " or " & query
Else
totalquery = totalquery & " | " & query
End If
query = ""
End If
textlist = ""
End Sub
Sub Terminate
If Not (failed) Then
Set collection = db.UnprocessedDocuments
For n = 0 To collection.Count
Set note = collection.GetNthDocument(n)
Call s.UpdateProcessedDoc(note)
Next
End If
End Sub
