I had made one excel to send automatic due date reminder mails via Groupwise (made with the help of your forums only).
The problem I am facing is as below:
[Also note, problem is not whether Groupwise or Outlook, problem is its generating multiple emails for each due item]
This is generating multiple emails and even the items not due are generating blank mails.
I would like to generate only one mail with different items different expiration dates.
After that group the identical addressees and compose one message with all the relevant data.
Mail 1: Please take notice of the following expiration date(s):
-Equipment A Job aaaaa expiration date : 19-Aug-12 -394 days.
-Equipment A Job aaaaa OVERDUE : 19-Aug-12 -394 days.
Sent at 17-Sep-13 11:11:04 AM
Mail 3: Please take notice of the following expiration date(s):
-Equipment C Job cccccc expiration date : 19-May-13 -121 days.
-Equipment C Job cccccc OVERDUE : 19-May-13 -121 days.
Sent at 17-Sep-13 11:11:04 AM
And the ones not due, going blank, i.e: the mail body (Mail 2) text reads:
"Please take notice of the following expiration date(s):
Sent at 17-Sep-13 11:11:04 AM"
What I wanted was a single mail with following in the mail body (Example):
" Please take notice of the following expiration date(s):
-Equipment A Job aaaaa expiration date : 19-Aug-12 -394 days.
-Equipment A Job aaaaa OVERDUE : 19-Aug-12 -394 days.
-Equipment C Job cccccc expiration date : 19-May-13 -121 days.
-Equipment C Job cccccc OVERDUE : 19-May-13 -121 days.
Sent at 17-Sep-13 11:11:04 AM"
Is this possible? Please check my VBA code & kindly help me resolve this. Code below:
Option Explicit
Private ogwApp As GroupwareTypeLibrary.Application
Private ogwRootAcct As GroupwareTypeLibrary.account
Const NL As String = vbNewLine
Const DNL As String = vbNewLine & vbNewLine
Private Sub Email_Multiple_Users_Via_Groupwise()
EndSub
Private Sub Workbook_Open()
Dim Cell As Range
Dim DateRng As Range
Dim Msg As String
Dim RngEnd As Range
Dim Wks As Worksheet
Dim xRow As Integer
Dim xCol As Integer
Const NGW$ = "NGW"
Dim ogwNewMessage As GroupwareTypeLibrary.Mail
Dim StrLoginName As String, _
StrMailPassword As String, _
StrSubject As String, _
StrBody As String, _
strAttachFullPathName As String, _
sCommandOptions As String, _
cl As Range
'Added fields
Dim eDefault As Range
Set Wks = Worksheets("Sheet1")
' Hans: 6 June: Will not use the three lines below
Set DateRng = Wks.Range("E2")
Set RngEnd = Wks.Range("E331")
Set DateRng = IIf(RngEnd.Row < DateRng.Row, DateRng, Wks.Range(DateRng, RngEnd))
For xRow = 2 To 331
If Len(Trim(Range("G" & xRow).Value)) = 0 Then
Range("K" & xRow).Value = 0
Else
Range("K" & xRow).Value = IIf(Date - Range("G" & xRow).Value <= 3, 0, 1)
End If
If (Len(Trim(Wks.Range("A" & xRow).Value) & Trim(Wks.Range("B" & xRow).Value & _
Trim(Wks.Range("C" & xRow).Value) & Trim(Wks.Range("D" & xRow).Value))) > 0) Then
If Range("F" & xRow).Value = False Or Range("K" & xRow).Value = 1 Then
'Change this to what you want.
Msg = "Please take notice of the following expiration date(s):" & Chr(10)
If Wks.Range("E" & xRow).Value - Date <= 15 And Len(Trim(Wks.Range("E" & xRow).Value)) > 0 Then
Msg = Msg & Chr(9) & "-" & Wks.Range("A1").Value & " " & Wks.Range("A" & xRow).Value & " " & Wks.Range("B1").Value & " " & Wks.Range("B" & xRow).Value & _
Chr(9) & "expiration date : " & Wks.Range("E" & xRow).Value & " " & Wks.Range("E" & xRow).Value - Date & " days." & Chr(10)
End If
If Wks.Range("E" & xRow).Value < Date And Len(Trim(Wks.Range("E" & xRow).Value)) > 0 Then
Msg = Msg & Chr(9) & "-" & Wks.Range("A1").Value & " " & Wks.Range("A" & xRow).Value & " " & Wks.Range("B1").Value & " " & Wks.Range("B" & xRow).Value & _
Chr(9) & "OVERDUE : " & Wks.Range("E" & xRow).Value & " " & Wks.Range("E" & xRow).Value - Date & " days." & Chr(10)
End If
If Range("K" & xRow).Value = 1 Then
Msg = Msg & Chr(10) & "A message reminding you was sent on " & Range("G" & xRow).Value & Chr(10) & _
"No action has yet been taken." & Chr(10)
End If
'SECTION 2
'Set all required variables
StrLoginName = "sdas" 'Enter your mailbox ID here
StrMailPassword = "Sdas2012" 'A true password is not required
StrSubject = "Expiry dates Alert !!"
StrBody = Msg & vbCrLf & _
"Sent at " & Now()
strAttachFullPathName = "" 'Put full path of workbook to be attached between quotes.
'SECTION 3
'Create the Groupwise object and login in to Groupwise
'Set application object reference if needed
If ogwApp Is Nothing Then 'Need to set object reference
DoEvents
Set ogwApp = CreateObject("NovellGroupWareSession")
DoEvents
End If
If ogwRootAcct Is Nothing Then 'Need to log in
'Login to root account
If Len(StrMailPassword) Then 'Password was passed, so use it
sCommandOptions = "/pwd=" & StrMailPassword
Else 'Password was not passed
sCommandOptions = vbNullString
End If
Set ogwRootAcct = ogwApp.Login(StrLoginName, sCommandOptions, _
, egwPromptIfNeeded)
DoEvents
End If
'SECTION 4
'Create and Send the Message
'Create new message
Set ogwNewMessage = ogwRootAcct.WorkFolder.Messages.Add _
("GW.MESSAGE.MAIL", egwDraft)
DoEvents
'Assign "To" recipients
For Each cl In ActiveSheet.Range("Email_To")
If Not cl.Value = "" Then ogwNewMessage.Recipients.Add cl.Value, NGW, egwTo
Next cl
'Assign "CC" recipients
For Each cl In ActiveSheet.Range("Email_CC")
If Not cl.Value = "" Then ogwNewMessage.Recipients.Add cl.Value, NGW, egwCC
Next cl
'Assign "BC" recipients
For Each cl In ActiveSheet.Range("Email_BC")
If Not cl.Value = "" Then ogwNewMessage.Recipients.Add cl.Value, NGW, egwBC
Next cl
With ogwNewMessage
'Assign the SUBJECT text
If Not StrSubject = "" Then .Subject = StrSubject
'Assign the BODY text
If Not StrBody = "" Then .BodyText = StrBody
'Assign Attachment(s)
If Not strAttachFullPathName = "" Then .Attachments.Add strAttachFullPathName
'Send the message
On Error Resume Next
'Send method may fail if recipients don't resolve
.Send
DoEvents
On Error GoTo 0
End With
'SECTION 5
'Release all variables
Set ogwNewMessage = Nothing
Set ogwRootAcct = Nothing
Set ogwApp = Nothing
DoEvents
Range("F" & xRow).Value = True
Range("G" & xRow).Value = Date
Range("K" & xRow).Value = IIf(Date - Range("K" & xRow).Value <= 3, 0, 1)
End If
End If
Next xRow
Set ogwApp = Nothing
End Sub
Sub CheckDue()
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
End Sub
Private Sub Workbook_Sync(ByVal SyncEventType As Office.MsoSyncEventType)
End Sub
The problem I am facing is as below:
[Also note, problem is not whether Groupwise or Outlook, problem is its generating multiple emails for each due item]
This is generating multiple emails and even the items not due are generating blank mails.
I would like to generate only one mail with different items different expiration dates.
After that group the identical addressees and compose one message with all the relevant data.
Mail 1: Please take notice of the following expiration date(s):
-Equipment A Job aaaaa expiration date : 19-Aug-12 -394 days.
-Equipment A Job aaaaa OVERDUE : 19-Aug-12 -394 days.
Sent at 17-Sep-13 11:11:04 AM
Mail 3: Please take notice of the following expiration date(s):
-Equipment C Job cccccc expiration date : 19-May-13 -121 days.
-Equipment C Job cccccc OVERDUE : 19-May-13 -121 days.
Sent at 17-Sep-13 11:11:04 AM
And the ones not due, going blank, i.e: the mail body (Mail 2) text reads:
"Please take notice of the following expiration date(s):
Sent at 17-Sep-13 11:11:04 AM"
What I wanted was a single mail with following in the mail body (Example):
" Please take notice of the following expiration date(s):
-Equipment A Job aaaaa expiration date : 19-Aug-12 -394 days.
-Equipment A Job aaaaa OVERDUE : 19-Aug-12 -394 days.
-Equipment C Job cccccc expiration date : 19-May-13 -121 days.
-Equipment C Job cccccc OVERDUE : 19-May-13 -121 days.
Sent at 17-Sep-13 11:11:04 AM"
Is this possible? Please check my VBA code & kindly help me resolve this. Code below:
Option Explicit
Private ogwApp As GroupwareTypeLibrary.Application
Private ogwRootAcct As GroupwareTypeLibrary.account
Const NL As String = vbNewLine
Const DNL As String = vbNewLine & vbNewLine
Private Sub Email_Multiple_Users_Via_Groupwise()
EndSub
Private Sub Workbook_Open()
Dim Cell As Range
Dim DateRng As Range
Dim Msg As String
Dim RngEnd As Range
Dim Wks As Worksheet
Dim xRow As Integer
Dim xCol As Integer
Const NGW$ = "NGW"
Dim ogwNewMessage As GroupwareTypeLibrary.Mail
Dim StrLoginName As String, _
StrMailPassword As String, _
StrSubject As String, _
StrBody As String, _
strAttachFullPathName As String, _
sCommandOptions As String, _
cl As Range
'Added fields
Dim eDefault As Range
Set Wks = Worksheets("Sheet1")
' Hans: 6 June: Will not use the three lines below
Set DateRng = Wks.Range("E2")
Set RngEnd = Wks.Range("E331")
Set DateRng = IIf(RngEnd.Row < DateRng.Row, DateRng, Wks.Range(DateRng, RngEnd))
For xRow = 2 To 331
If Len(Trim(Range("G" & xRow).Value)) = 0 Then
Range("K" & xRow).Value = 0
Else
Range("K" & xRow).Value = IIf(Date - Range("G" & xRow).Value <= 3, 0, 1)
End If
If (Len(Trim(Wks.Range("A" & xRow).Value) & Trim(Wks.Range("B" & xRow).Value & _
Trim(Wks.Range("C" & xRow).Value) & Trim(Wks.Range("D" & xRow).Value))) > 0) Then
If Range("F" & xRow).Value = False Or Range("K" & xRow).Value = 1 Then
'Change this to what you want.
Msg = "Please take notice of the following expiration date(s):" & Chr(10)
If Wks.Range("E" & xRow).Value - Date <= 15 And Len(Trim(Wks.Range("E" & xRow).Value)) > 0 Then
Msg = Msg & Chr(9) & "-" & Wks.Range("A1").Value & " " & Wks.Range("A" & xRow).Value & " " & Wks.Range("B1").Value & " " & Wks.Range("B" & xRow).Value & _
Chr(9) & "expiration date : " & Wks.Range("E" & xRow).Value & " " & Wks.Range("E" & xRow).Value - Date & " days." & Chr(10)
End If
If Wks.Range("E" & xRow).Value < Date And Len(Trim(Wks.Range("E" & xRow).Value)) > 0 Then
Msg = Msg & Chr(9) & "-" & Wks.Range("A1").Value & " " & Wks.Range("A" & xRow).Value & " " & Wks.Range("B1").Value & " " & Wks.Range("B" & xRow).Value & _
Chr(9) & "OVERDUE : " & Wks.Range("E" & xRow).Value & " " & Wks.Range("E" & xRow).Value - Date & " days." & Chr(10)
End If
If Range("K" & xRow).Value = 1 Then
Msg = Msg & Chr(10) & "A message reminding you was sent on " & Range("G" & xRow).Value & Chr(10) & _
"No action has yet been taken." & Chr(10)
End If
'SECTION 2
'Set all required variables
StrLoginName = "sdas" 'Enter your mailbox ID here
StrMailPassword = "Sdas2012" 'A true password is not required
StrSubject = "Expiry dates Alert !!"
StrBody = Msg & vbCrLf & _
"Sent at " & Now()
strAttachFullPathName = "" 'Put full path of workbook to be attached between quotes.
'SECTION 3
'Create the Groupwise object and login in to Groupwise
'Set application object reference if needed
If ogwApp Is Nothing Then 'Need to set object reference
DoEvents
Set ogwApp = CreateObject("NovellGroupWareSession")
DoEvents
End If
If ogwRootAcct Is Nothing Then 'Need to log in
'Login to root account
If Len(StrMailPassword) Then 'Password was passed, so use it
sCommandOptions = "/pwd=" & StrMailPassword
Else 'Password was not passed
sCommandOptions = vbNullString
End If
Set ogwRootAcct = ogwApp.Login(StrLoginName, sCommandOptions, _
, egwPromptIfNeeded)
DoEvents
End If
'SECTION 4
'Create and Send the Message
'Create new message
Set ogwNewMessage = ogwRootAcct.WorkFolder.Messages.Add _
("GW.MESSAGE.MAIL", egwDraft)
DoEvents
'Assign "To" recipients
For Each cl In ActiveSheet.Range("Email_To")
If Not cl.Value = "" Then ogwNewMessage.Recipients.Add cl.Value, NGW, egwTo
Next cl
'Assign "CC" recipients
For Each cl In ActiveSheet.Range("Email_CC")
If Not cl.Value = "" Then ogwNewMessage.Recipients.Add cl.Value, NGW, egwCC
Next cl
'Assign "BC" recipients
For Each cl In ActiveSheet.Range("Email_BC")
If Not cl.Value = "" Then ogwNewMessage.Recipients.Add cl.Value, NGW, egwBC
Next cl
With ogwNewMessage
'Assign the SUBJECT text
If Not StrSubject = "" Then .Subject = StrSubject
'Assign the BODY text
If Not StrBody = "" Then .BodyText = StrBody
'Assign Attachment(s)
If Not strAttachFullPathName = "" Then .Attachments.Add strAttachFullPathName
'Send the message
On Error Resume Next
'Send method may fail if recipients don't resolve
.Send
DoEvents
On Error GoTo 0
End With
'SECTION 5
'Release all variables
Set ogwNewMessage = Nothing
Set ogwRootAcct = Nothing
Set ogwApp = Nothing
DoEvents
Range("F" & xRow).Value = True
Range("G" & xRow).Value = Date
Range("K" & xRow).Value = IIf(Date - Range("K" & xRow).Value <= 3, 0, 1)
End If
End If
Next xRow
Set ogwApp = Nothing
End Sub
Sub CheckDue()
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
End Sub
Private Sub Workbook_Sync(ByVal SyncEventType As Office.MsoSyncEventType)
End Sub
