Reminder per email

[Alperen15]

hi, ich habe ein problem. Ich habe eine Ansicht in der alle Mitarbeiter aufgelistet sind die ein bestimmtes Dokument nicht bestätigt haben. Diese Mitarbeiter sollen einen Reminder bekommen mit dem entsprechenden Link. doch die Kollegen bekommen diese email 3mal hintereinander. Könntet Ihr mir vllt behilflich sein? wäre echt nett. Hier mein Quellcode


Sub Initialize
   
   Dim session As New NotesSession
   Dim ws As New NotesUIWorkspace
   Dim db As NotesDatabase
   Dim names As NotesDatabase
   Dim oView As NotesView
   Dim oSearchDoc As NotesDocument
   Dim oNeuDoc As NotesDocument
   Dim doc As NotesDocument
   Dim ProfilDoc As NotesDocument
   Dim uid As String
   Dim heute As New NotesDateTime("Today")
   Dim username As New NotesName(session.CommonUserName)
   Dim RTItemProfileDoc As Variant
   Dim iSendError As Integer     ' Flag, ob ein Sendefehler aufgetreten ist
   Dim cText As String
   Dim cError As String
   Dim zaehler As Integer
   Dim ErrMessage As String
   Dim cEmpfaenger As String
   
   Set db = session.CurrentDatabase
   Set ProfilDoc = db.GetProfileDocument("PDAllgemein")
   Set RTItemProfileDoc = ProfilDoc.GetFirstItem("fdReminder")
   Set oView = db.GetView("vwRem1")   
   
   REM Tracerinitialisierungsparameter
   Dim aTracerPara(1) As Variant   
   cgTracerReklaImport = "aaRem1"   
   aTracerPara(0) = "Reminder"
   aTracerPara(1) = "PDAllgemein"
   If Not(xQAnfangID(aTracerPara)) Then
      Print "Agent: aaRem1: Konnte Tracer/Logger/Protokoll nicht initialisieren. Abbruch der Funktion."
      Exit Sub
   End If     ' If Not(xQAnfangID(aTracerPara)) Then   
   
   
   Set oSearchDoc = oView.GetFirstDocument
   
   If oSearchDoc Is Nothing Then
      Call XQSchreiben("0", "1", cgTracerReklaImport, "aaRem1 ERROR: Keine Dokumente zum Verarbeiten", 632637&)         
      Goto EndeAlles
   End If
   
   
   While Not (oSearchDoc Is Nothing)
      zaehler = 0
      ' eMail erstellen und versenden
      Set oNeuDoc = db.CreateDocument                              
      oNeuDoc.Form = "Memo"
      oNeuDoc.Subject = "Reminder: Newsletter Arbeitssicherheit"
      Set oRTItem = New NotesRichTextItem(oNeuDoc, "Body")    ' *** in Body des Memos reinschreiben
      Call oRTItem.appendRTItem(RTItemProfileDoc)
      Call oRtitem.AddNewLine(4)
      Call oRtitem.AppendText("Verbindung zum Newsletter-Dokument. Bitte klicken. ---> ")
      Call  oRTItem.AppendDoclink(oSearchDoc, " Verbindung zum Newsletter-Dokument. Bitte klicken.")
      
      cEmpfaenger = Cstr(oSearchDoc.fdName(0))
      
      cError = "asCreditImport ERROR: CredMail Send " + cEmpfaenger
      On Error Goto ErrorPrint
      iSendError = False            
      Call oNeuDoc.Send(False, cEmpfaenger)   
      If iSendError Then
         cError = "Error:  ReminderMail Send " + cEmpfaenger
         Goto ErrorPrint
      End If     ' If iSendError Then
      
      Call doc.Send( False, "Uezeyir Kural/Rutronik/De")
      zaehler = zaehler +1
      Set oSearchDoc = oView.GetNextDocument(oSearchDoc)      
   Wend
   
   Call XQSchreiben("0", "1", cgTracerReklaImport, "Ende Reminder", 632637&)   
   
   
   cText = Cstr(zaehler) + " Dokumente bearbeitet"
   Call XQSchreiben("0", "1", cgTracerReklaImport, cText, 632637&)      
   Goto EndeAlles
   
   
ErrorPrint:   
   ErrMessage =  "Error : " + Cstr(Err) & " " & Error$ &  " on line " & Cstr(Erl)
   Call XQSchreiben("0", "1", cgTracerReklaImport, cError & " -> " & ErrMessage, 632637&)      
   Resume Next
   
EndeAlles:
   Call xQEnde
   
End Sub

[Klafu]

Hallo du,


anhand deiner Aussage, solltest du dir also mal die Schleife angucken, in der du die E-Mails verschickst.
Eine Mail wird solang verschickt, bis "While Not (oSearchDoc Is Nothing)" ist.

Chris

[koehlerbv]

Das kann nicht der ganze Code sein, denn das Call doc.Send würde den Code mit einer Fehlermeldung zum Stoppen bringen.

Weiters: Wie soll sich der Status von iSendError ändern?

Ansonsten kann der veröffentlichte Code pro Dokument aber tatsächlich nur einen Empfänger eine mail zukommen lassen ...

Bernhard

[Alperen15]

hi,

das ist auch nicht der ganze code denn ich benutze auch die Script Bibliothek falls es Fehler auftreten sollte.

Mir geht es nur um die schleife wie das korrekt aussieht und ob ihr mir da behilflich sein könntet.

[Klafu]

Also im prinzip wir bei jedem schleifen durchlauf bei dir eine Mail versendet - vermutlich liegt da die Ursache der mehrfach erstellten E-Mails.
Außerdem bringt deine zaehler Variable nicht viel, da die entweder nur 0 oder 1 sein kann, da du sie bei jedem durchlaufen der Schleife gleich am anfang wieder auf 0 setzt.
Und bei Doc.Send hast du als Empfänger nur eine Person eingetragen. Das heißt die bekommt die Mail jedesmal.
Ist das so gewollt ?

Chris

[Alperen15]

ja die person bekommt die email nur wenn ein Fehler auftritt. Ist so auch in Ordnung.

[Alperen15]

hallo???

könnte mir einer sagen was ich quellcode verbessern soll bzw wie es aussehen soll??

[Peter Klett]

ja die person bekommt die email nur wenn ein Fehler auftritt. Ist so auch in Ordnung.

Dann hast Du das nicht richtig getestet, das kann so nicht in Ordnung sein.

Konzentriere Dich mal auf diesen Teil:

      On Error Goto ErrorPrint
      iSendError = False           
      Call oNeuDoc.Send(False, cEmpfaenger)   
      If iSendError Then
         cError = "Error:  ReminderMail Send " + cEmpfaenger
         Goto ErrorPrint
      End If     ' If iSendError Then
     
      Call doc.Send( False, "Uezeyir Kural/Rutronik/De")

Im Fehlerfall soll das Script zu ErrorPrint springen.
Du setzt iSendError auf False, dann sendest Du ein Dokument an cEmpfaenger.
Danach prüfst Du iSendError. Vermutlich wird das in der XQSchreiben gesetzt, was in ErrorPrint aufgerufen wird. Wenn das True ist, setzt Du cError und führts nochmal ErrorPrint aus. Danach sendet Du eine Mail an Uezeyir Kural, unabhängig davon, ob ein Fehler augetreten ist, oder nicht.

Und das ist alles in Ordnung? Das kann ich nicht glauben ... Und wenn doch, wo ist dann Dein Problem?

[Alperen15]

a ok hast wieder mal recht =) danke. Hab mein Fehler gefunden thx