hardik_088
Registered User.
- Local time
- Today, 16:40
- Joined
- May 31, 2011
- Messages
- 82
hi guys,
I have created automatic email but when somebody is logout or close and open database again then it is sending email so receiver can be boared from one email so i am thinking email should go just one time in a day.It doesnot matter how much time it open or close or logout .
so what can i do?
below is my code
Option Compare Database
Private Sub Form_Timer()
Me.Visible = False
CheckOrderLevels "Laptops", "[Part number]", "[quantity ordered]", "Laptops"
'CheckOrderLevels "Printers", "[Part Number]", "[quantity ordered]", "Printers"
'CheckOrderLevels "Licences", "[Part Number]", "[quantity ordered]", "Licences"
'CheckOrderLevels "Mobility", "[Part Number]", "[quantity ordered]", "Mobility"
'CheckOrderLevels "[Pc's]", "[Part Number]", "[quantity ordered]", "[Pc's]"
'CheckOrderLevels "Peripherals", "[Part Number]", "[quantity ordered]", "Peripherals"
'CheckOrderLevels "Services", "[Part Number]", "[quantity ordered]", "Services"
'CheckOrderLevels "Softwares", "[Part Number]", "[quantity ordered]", "Softwares"
'CheckOrderLevels "Supplies", "[Part Number]", "[quantity ordered]", "Supplies"
'CheckOrderLevels "Travel", "[Part Number]", "[quantity ordered]", "Travel"
Me.TimerInterval = 3000
End Sub
Private Sub CheckOrderLevels(ByVal strTable As String, ByVal strNameField As String, ByVal strQuantityField As String, ByVal strProduct As String)
On Error Resume Next
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT " & strNameField & " FROM " & strTable _
& " WHERE " & strQuantityField & " < 3", dbOpenSnapshot)
With rs
If .RecordCount > 0 Then
Dim sProducts As String
Dim bFirst As Boolean
sProducts = ""
bFirst = True
.MoveFirst
Do While Not .EOF
If Not bFirst Then sProducts = sProducts & vbCrLf
sProducts = .Fields(strNameField)
bFirst = False
.MoveNext
Loop
SendReport strTable, strProduct, sProducts
End If
.Close
End With
End Sub
Private Sub SendReport(ByVal strTable As String, ByVal strProduct As String, ByVal sProducts As String)
On Error Resume Next
Dim olApp As Object
Dim objMail As Object
Set olApp = GetObject(, "Outlook.Application")
If Err Then Set olApp = CreateObject("Outlook.Application")
Set objMail = olApp.CreateItem(olMailItem)
With objMail
.BodyFormat = olFormatHTML
.To = Forms!Welcome![EmailAddress].Value
.Subject = "Automated message: " & strProduct & " Requires Ordering"
.HTMLBody = "There is less than three items (Part Number is : " & sProducts & ") in " & strTable & " table"
.Send
End With
End Sub
Thank you very much.
I have created automatic email but when somebody is logout or close and open database again then it is sending email so receiver can be boared from one email so i am thinking email should go just one time in a day.It doesnot matter how much time it open or close or logout .
so what can i do?
below is my code
Option Compare Database
Private Sub Form_Timer()
Me.Visible = False
CheckOrderLevels "Laptops", "[Part number]", "[quantity ordered]", "Laptops"
'CheckOrderLevels "Printers", "[Part Number]", "[quantity ordered]", "Printers"
'CheckOrderLevels "Licences", "[Part Number]", "[quantity ordered]", "Licences"
'CheckOrderLevels "Mobility", "[Part Number]", "[quantity ordered]", "Mobility"
'CheckOrderLevels "[Pc's]", "[Part Number]", "[quantity ordered]", "[Pc's]"
'CheckOrderLevels "Peripherals", "[Part Number]", "[quantity ordered]", "Peripherals"
'CheckOrderLevels "Services", "[Part Number]", "[quantity ordered]", "Services"
'CheckOrderLevels "Softwares", "[Part Number]", "[quantity ordered]", "Softwares"
'CheckOrderLevels "Supplies", "[Part Number]", "[quantity ordered]", "Supplies"
'CheckOrderLevels "Travel", "[Part Number]", "[quantity ordered]", "Travel"
Me.TimerInterval = 3000
End Sub
Private Sub CheckOrderLevels(ByVal strTable As String, ByVal strNameField As String, ByVal strQuantityField As String, ByVal strProduct As String)
On Error Resume Next
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT " & strNameField & " FROM " & strTable _
& " WHERE " & strQuantityField & " < 3", dbOpenSnapshot)
With rs
If .RecordCount > 0 Then
Dim sProducts As String
Dim bFirst As Boolean
sProducts = ""
bFirst = True
.MoveFirst
Do While Not .EOF
If Not bFirst Then sProducts = sProducts & vbCrLf
sProducts = .Fields(strNameField)
bFirst = False
.MoveNext
Loop
SendReport strTable, strProduct, sProducts
End If
.Close
End With
End Sub
Private Sub SendReport(ByVal strTable As String, ByVal strProduct As String, ByVal sProducts As String)
On Error Resume Next
Dim olApp As Object
Dim objMail As Object
Set olApp = GetObject(, "Outlook.Application")
If Err Then Set olApp = CreateObject("Outlook.Application")
Set objMail = olApp.CreateItem(olMailItem)
With objMail
.BodyFormat = olFormatHTML
.To = Forms!Welcome![EmailAddress].Value
.Subject = "Automated message: " & strProduct & " Requires Ordering"
.HTMLBody = "There is less than three items (Part Number is : " & sProducts & ") in " & strTable & " table"
.Send
End With
End Sub
Thank you very much.