Mail bei abgelaufenen Referenzmaterialien

Um 31 Tage vor dem Ablaufen eines Referenzmaterials informiert zu werden, muss das LIMS mit einem Skript gefüttert werden.  Heute zeige ich, wie dieses Skript eingepflegt wird. Es werden Verantwortlicher sowie optional auch der QMV benachrichtigt. Wenn das Skript für die Benachrichtigung auf abgelaufene F506-1 schon im LIMS ist, sollte dieses entfernt werden, da dieses Skript das alte ersetzt.

Für diesen Workshop werden benötigt:

  • Administratoren-Rechte

So sieht eine Benachrichtigung aus:

Die Spezilalmail kann in den ownSettings eingefügt werden. Diese kann aus der Startleiste der Probenplanung gestartet werden. Es werden Administrator-Rechte benötigt.

In den ownSettings wählt man "Skriptplugins" aus und klickt auf "Weiter".


Im neuen Fenster wählt man als Programmteil "Spezialmails" aus und klickt dann auf "neues Skript". Nun muss ein Name für das Skript eingegeben werden, z.B. "abgelaufene Referenzmaterialien".

Jetzt müssen noch die Sub "Start()" editiert und die neue Function "TextZuASCII(Text)" eingefügt werden:

Sub Start
Dim RS, Datum, Von, Bis, html, Link, Mail

    If Date = Fix(Mails.LastRun) Then Exit Sub 'nur einmal pro Tag ausführen
    
    Von=Fix(Mails.LastRun)+1 + 31
    Von=Datum_Konvert(CStr(Von))

    Bis=Date + 31
    Bis=Datum_Konvert(CStr(Bis))

    RSOpen RS, "SELECT R.RMID, R.Name, U.EMail, R.Mindesthaltbarkeit, R.Geöffnet, R.GeöffnetHaltbarkeit, R.Codierung FROM t_QSMU_RefMatDef AS R INNER JOIN t_UserDef AS U ON R.Verantwortlicher=U.UID WHERE R.Aktuell=1 AND ( (R.Mindesthaltbarkeit>=" & Von & " AND R.Mindesthaltbarkeit <=" & Bis & " ) OR (R.Geöffnet + R.GeöffnetHaltbarkeit>=" & Von & " AND R.Geöffnet + R.GeöffnetHaltbarkeit<=" & Bis & " ) )"
    
    Do Until RS.BOF Or RS.EOF
        Link="pp://$" & TextZuASCII("Probenplanung|FRM FRM_Verwaltung RMID=" & RS.Fields(0).Value)
        
        html="<html><body>"
        html=html & "<b>Achtung!</b><br />" & vbnewline
        html=html & "Folgendes Referenzmaterial l&auml;uft bald ab: <br />" & vbnewline
        html=html & "<a href=""" & Link & """>" & Mails.httpReplace(RS.Fields(1).Value) & "</a><br ><br />" & vbnewline
        html=html & "Codierung/Batch-Nr.:" & Mails.httpReplace(RS.Fields(6).Value) &  "<br />" & vbnewline
        html=html & "Mindesthaltbarkeit: " & RS.Fields(3).Value & "<br />" & vbnewline
        html=html & "Ge&ouml;ffnet: " & RS.Fields(4).Value & "<br />" & vbnewline
        html=html & "Haltbarkeit nach &Ouml;ffnen: " & RS.Fields(5).Value & " Tage (" & (RS.Fields(4).Value + RS.Fields(5).Value) & ")<br />" & vbnewline
        html=html & "</body></html>"
        
        Set Mail=Mails.Add
        Mail.HTMLText=html
        Mail.Betreff="Achtung: Referenzmaterial läuft bald ab: " & RS.Fields(1).Value
        If Not IsNull(RS.Fields(2).Value) Then Mail.Empfaenger.Add RS.Fields(2).Value
        'Mail.Empfaenger.Add QMV hier einfügen

        RS.MoveNext
    Loop
    
    Mails.LastRun = Now
End Sub

Private Function TextZuASCII(Text)
Dim i
    For i=1 to Len(Text)
        TextZuASCII=TextZuASCII & Right("000" & Asc(Mid(Text,i,1)), 3)
    Next
End Function

Wer möchte kann ziemlich am Ende der Sub Start() in der Zeile "'Mail.Empfaenger.Add QMV hier einfügen" den Kommentar entfernen und dort in Anführungsstrichen die E-Mail-Adresse seines QMVs eintragen. Also z.B. Mail.Empfaenger.Add "QMV@NLWKN-Bst.Niedersachsen.de".

Ein Klick  auf "Test" verrät einem, ob Fehler in dem Skript sind. Wenn keine Fehler vorhanden sind, kann das Skript gespeichert werden. Der Regelserver wird nun einmal täglich nach Referenzmaterialien suchen, die in 31 Tagen abgelaufen sind.