Thread: How do I pass parameters from one to another subroutines

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:

Code:

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

Your post does not comply with the Forum Rules. Per rule # 3, all VBA code must be wrapped in code tags. Please amend your post to add the code tags, after which, possible solutions will be suggested. Thanks.

Rule #3.

Use code tags around code. Posting code without them makes your code hard to read and difficult to be copied for testing. Highlight your code and click the # button at the top of the post window. If you are editing an existing post, press Go Advanced to see the # button. For more information about these and other tags, click here.

Like so:

Code:

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"


SendNotesMail Mailsubj1, Mailsubj2
End If
Next

End Sub


Sub SendNotesMail(MailSubj1 As String, MailSubj2 As String)
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