kyameizero
New Member
- Joined
- Jan 2, 2020
- Messages
- 19
- Office Version
- 365
- Platform
- Windows
I have a code that can send emails to the people that I want. The code sends emails based on the number "1" I placed in Column J. However, even if there are number 1s on 3 rows, the code only sends the email to the top person.
How do I make it so that the code will send to all rows which have a number "1" in Column J?
Help please
This is the code that I have:
Sub notify1()
Dim rng As Range
For Each rng In Range("J2:J24")
If (rng.Value = 1) Then
Call mymacro1
End If
Next rng
End Sub
Private Sub mymacro1()
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Dim xRgName As Range
Dim xRgSend As Range
Dim xRgDate As Range
Dim xRgQual As Range
Dim xRgEPNo As Range
Dim xRgNameVal As String
Dim xRgSendVal As String
Dim xRgDateVal As String
Dim xRgQualVal As String
Dim xRgEPNoVal As String
Dim xMailSubject As String
Dim xLastRow As Long
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xRgName = ActiveSheet.Range("B2:B24")
Set xRgDate = ActiveSheet.Range("G2:G24")
Set xRgSend = ActiveSheet.Range("H2:H24")
Set xRgQual = ActiveSheet.Range("E2:E24")
Set xRgEPNo = ActiveSheet.Range("D2:E24")
Set xRgName = xRgName(1)
Set xRgDate = xRgDate(1)
Set xRgSend = xRgSend(1)
Set xRgQual = xRgQual(1)
Set xRgEPNo = xRgEPNo(1)
xRgNameVal = xRgName.Value
xRgSendVal = xRgSend.Value
xRgDateVal = xRgDate.Value
xRgQualVal = xRgQual.Value
xRgEPNoVal = xRgEPNo.Value
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Dear " & xRgNameVal & ", EP number: " & xRgEPNo & ", " & vbNewLine & vbNewLine & _
"Your " & xRgQualVal & " is expiring on " & xRgDateVal & vbNewLine & _
"Please renew your qualification as soon a possible."
xMailSubject = "Your " & xRgQualVal & " qualification is expiring soon!"
On Error Resume Next
With xOutMail
.To = xRgSendVal
.CC = ""
.BCC = ""
.Subject = xMailSubject
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
How do I make it so that the code will send to all rows which have a number "1" in Column J?
Help please
This is the code that I have:
Sub notify1()
Dim rng As Range
For Each rng In Range("J2:J24")
If (rng.Value = 1) Then
Call mymacro1
End If
Next rng
End Sub
Private Sub mymacro1()
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Dim xRgName As Range
Dim xRgSend As Range
Dim xRgDate As Range
Dim xRgQual As Range
Dim xRgEPNo As Range
Dim xRgNameVal As String
Dim xRgSendVal As String
Dim xRgDateVal As String
Dim xRgQualVal As String
Dim xRgEPNoVal As String
Dim xMailSubject As String
Dim xLastRow As Long
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xRgName = ActiveSheet.Range("B2:B24")
Set xRgDate = ActiveSheet.Range("G2:G24")
Set xRgSend = ActiveSheet.Range("H2:H24")
Set xRgQual = ActiveSheet.Range("E2:E24")
Set xRgEPNo = ActiveSheet.Range("D2:E24")
Set xRgName = xRgName(1)
Set xRgDate = xRgDate(1)
Set xRgSend = xRgSend(1)
Set xRgQual = xRgQual(1)
Set xRgEPNo = xRgEPNo(1)
xRgNameVal = xRgName.Value
xRgSendVal = xRgSend.Value
xRgDateVal = xRgDate.Value
xRgQualVal = xRgQual.Value
xRgEPNoVal = xRgEPNo.Value
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Dear " & xRgNameVal & ", EP number: " & xRgEPNo & ", " & vbNewLine & vbNewLine & _
"Your " & xRgQualVal & " is expiring on " & xRgDateVal & vbNewLine & _
"Please renew your qualification as soon a possible."
xMailSubject = "Your " & xRgQualVal & " qualification is expiring soon!"
On Error Resume Next
With xOutMail
.To = xRgSendVal
.CC = ""
.BCC = ""
.Subject = xMailSubject
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub