Emailing from Excel based on date selection by row

[Talat]

Hi

I need help with this code which should check all filled rows in the sheet
and compare the date in D(i) with todays date in "H1" and if = send an email.

The email part works OK and the code was taken from a forum . But the
parameters MailSubj1 and Mailsubj2 values are not passed to the SendNotesMail
subroutine. Can anyone help with this?


Here is the code:

------------------------- ooo ------------------------------

Sub checkdate()

Dim Ws As Worksheet
Dim oRow As Long
Dim Mailsubj1 As String
Dim Mailsubj2 As String


Set Ws = ThisWorkbook.Worksheets("RePrintSchedule")
oRow = Ws.UsedRange.Rows.Count + 1

'

For i = 2 To oRow

If Range("D" & (i)).Value = Range("H1").Value Then

Mailsubj1 = Range("A" & (i)).Value
Mailsubj2 = Range("B" & (i)).Value

'MsgBox Mailsubj2 & ": " & Mailsubj1 & " //eom"


Application.Run "SendNotesMail"
End If
Next

End Sub


Sub SendNotesMail()
Dim Maildb As Object, UserName As String, MailDbName As String
Dim MailDoc As Object, Session As Object
Dim myArr As Variant, i As Long

Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, _
(Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Session.GetDatabase("", MailDbName)
If Maildb.IsOpen = True Then
Else: Maildb.OpenMail
End If
Set MailDoc = Maildb.CreateDocument
MailDoc.Form = "Memo"
MailDoc.SendTo = "emailname @somewhere.com" 'Nickname or full address
'MailDoc.CopyTo = Whomever
'MailDoc.BlindCopyTo = Whomever

MsgBox Mailsubj2 & ": " & Mailsubj1 & " //eom"

MailDoc.Subject = Mailsubj2 & ": " & Mailsubj1
'myArr = Range([a2], [a65536].End(3))
'For i = LBound(myArr) To UBound(myArr)
'myArr(i) = Right(myArr(i), Len(myArr(i)) - 1)
'Next
MailDoc.Body = "Put mail message body here ....."
'Replace("As a result of a review of your AWP collections that" & _
' "I have carried out,@@I have asked Leisure Link to replace your ????? " & _
' "AWP.@@@@I or your Leisure Link Business Account Manager will try" & _
' "@@to phone you to discuss this within the next couple of days." & _
' "@@However if you have any immediate comments,@@please do not " & _
' "hesitate to contact either of us." & _
' Join(Application.Transpose(myArr), "@") & _
' "@@With kind regards", "@", vbCrLf)
MailDoc.SaveMessageOnSend = True
MailDoc.PostedDate = Now
On Error GoTo Audi
Call MailDoc.Send(False)
Set Maildb = Nothing: Set MailDoc = Nothing: Set Session = Nothing
Exit Sub
Audi:
Set Maildb = Nothing: Set MailDoc = Nothing: Set Session = Nothing
End Sub


------------- ooo --------------------------------------------------------

The sub procedure SendNotesMail() is someone elses work which I found in a
forum, and it works well for Lotus Notes client. Its teh passing parameters
to it from teh first sub procedure taht I need help with.

Thanks.