"C:\Program Files\Microsoft Office\Office14\MSACCESS.EXE" "s:\Quality Management System\_Records\Record Database\CAPADB\capalog.mdb" /user Auser /pwd password /WRKGRP "s:\Quality Management System\_Records\Record Database\CAPADB\secured.mdw" /x LateCAPANotice
Option Compare Database
'Send pop-up message or email notice based on timeliness of a given CAPA. At a specified time,
'this code scans the capalog table via the SUP_CAPANotice query and notifies necessary parties.
'The time is set by a Scheduled task on BobI's PC. If Bob's PC is off then the notification does not run.
Public Function Notify()
On Error GoTo Err_Notify
Dim stAppName As String
Dim winuser As String
Dim capano As String
Dim Ass As String
Dim supID As String
Dim sec3due As String
Dim sec4due As String
Dim dept As String
Dim SS1 As String
Dim SS2 As String
Dim Descr As String
Dim rst01 As ADODB.Connection
Set rst01 = CurrentProject.Connection
Dim myRecordSet As New ADODB.Recordset
myRecordSet.ActiveConnection = rst01
myRecordSet.Open "[SUP_CAPANotice]"
myRecordSet.MoveFirst
'----------------------------------------
'Issue Notices for Section III late Capas'
'send pop-ups to assignee and email to both assignee and supervisor
Do Until myRecordSet.EOF
If IsNull(myRecordSet.Fields(12).Value) Then '(If sec 3 complete date is blank)
If myRecordSet.Fields(11).Value < Now() Then '(If sec 3 due date is < today)
winuser = myRecordSet.Fields(29).Value
capano = myRecordSet.Fields(0).Value
Ass = myRecordSet.Fields(8).Value
supID = myRecordSet.Fields(31).Value
sec3due = myRecordSet.Fields(11).Value
Descr = myRecordSet.Fields(18).Value
'SEND POPUP to Assignee
stAppName = "net send " + [winuser] + " CAPA NO. " + [capano] + ", assigned to you, was Due: " + [sec3due] + " and is Late."
Call Shell(stAppName, 1)
'stAppName = "net send " + [supID] + " SUPERVISORY ALERT - CAPA NO. " + [capano] + ", assigned to " + [Ass] + ", was Due: " + [sec3due] + " and is Late. " + _
'"Please review this CAPA with your employee as necessary. Thank you..."
'Call Shell(stAppName, 1)
'ALSO SEND EMAIL to Assignee
Dim Outlook
Set Outlook = CreateObject("Outlook.Application")
Dim Message 'As Outlook.MailItem
Set Message = Outlook.CreateItem(olMailItem)
With Message
.Subject = "CAPA ALERT - Your CAPA is Late"
.Body = " CAPA ALERT - CAPA No. " + [capano] + ", assigned to you, is late as of " + [sec3due] + _
". Description: " + [Descr] + ". Notice has also been sent to your immediate supervisor. Thank you..."
.Recipients.Add ([Ass])
.Send
End With
'AND EMAIL to SUPERVISOR
Set Outlook = CreateObject("Outlook.Application")
Set Message = Outlook.CreateItem(olMailItem)
With Message
.Subject = "SUPERVISORY CAPA ALERT - A CAPA for your department is Late"
.Body = " CAPA ALERT - CAPA No. " + [capano] + ", assigned to " + [Ass] + ", is late as of " + [sec3due] + _
". Description: " + [Descr] + ". Please verify that your employee is working on this CAPA. " + [Ass] + " has also been notified. Thank you..."
.Recipients.Add ([supID])
.Send
End With
End If
End If
myRecordSet.MoveNext
Loop
'cut out more email sends based on various parameters.
If you're referring to something else please clarify.