Code for the below scenario - excel vba
Closed
jhakas
Posts
1
Registration date
Tuesday August 27, 2013
Status
Member
Last seen
August 27, 2013
-
Aug 27, 2013 at 05:59 AM
jhakas - Sep 6, 2013 at 05:16 AM
jhakas - Sep 6, 2013 at 05:16 AM
Related:
- Code for the below scenario - excel vba
- Battery reset code - Guide
- Samsung volume increase code - Guide
- Usa country code for whatsapp - Guide
- Number to words in excel formula without vba - Guide
- How to get whatsapp verification code online - Guide
5 responses
Ok so i have wireframed some code for the logic, but I am relectant to post automated code for sending emails.
This is very static, and I am certain there will be others to follow:
Sub SendEMail()
Dim r As Integer
Dim cnt As Integer
Dim temphour As String
Dim emailstring As String
Dim OutApp As Object
Dim OutMail As Object
Dim lastrow As Integer
lastrow = 10
For cnt = 1 To lastrow
For r = 2 To 5 'colums fo rhourly data, make certain they match what you are looking at
'find the hours in the columns after email, if not 8.5 then get the email in colum 1 of the current line
temphour = Sheet1.cells(cnt, r)
If temphour <> "8.5" Then
emailstring = Sheet1.cells(cnt, 1) 'gets the email
'**************************************
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = emailstring
.CC = ""
.BCC = ""
.Subject = "Daily hours"
.Body = "Hours not 8.5 for " & WeekdayName(r - 1, 0, vbSunday)
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
'*******************************************
End If
Next r
Next cnt
End Sub
This is very static, and I am certain there will be others to follow:
Sub SendEMail()
Dim r As Integer
Dim cnt As Integer
Dim temphour As String
Dim emailstring As String
Dim OutApp As Object
Dim OutMail As Object
Dim lastrow As Integer
lastrow = 10
For cnt = 1 To lastrow
For r = 2 To 5 'colums fo rhourly data, make certain they match what you are looking at
'find the hours in the columns after email, if not 8.5 then get the email in colum 1 of the current line
temphour = Sheet1.cells(cnt, r)
If temphour <> "8.5" Then
emailstring = Sheet1.cells(cnt, 1) 'gets the email
'**************************************
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = emailstring
.CC = ""
.BCC = ""
.Subject = "Daily hours"
.Body = "Hours not 8.5 for " & WeekdayName(r - 1, 0, vbSunday)
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
'*******************************************
End If
Next r
Next cnt
End Sub
Here is a simple wire frame...
I hope this isn't for a school project.
Sub SendEMail()
Dim r As Integer
Dim cnt As Integer
Dim temphour As String
Dim emailstring As String
Dim OutApp As Object
Dim OutMail As Object
Dim lastrow As Integer
lastrow = 10
For cnt = 1 To lastrow
For r = 2 To 5 'colums fo rhourly data, make certain they match what you are looking at
'find the hours in the columns after email, if not 8.5 then get the email in colum 1 of the current line
temphour = Sheet1.cells(cnt, r)
If temphour <> "8.5" Then
emailstring = Sheet1.cells(cnt, 1) 'gets the email
'**************************************
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = emailstring
.CC = ""
.BCC = ""
.Subject = "Daily hours"
.Body = "Hours not 8.5 for " & WeekdayName(r - 1, 0, vbSunday)
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
'*******************************************
End If
Next r
Next cnt
End Sub
Have fun. If it doesn't work in your sheet, then make certain al of the cell references are coorect, as I am trying to wireframe it, and not give you an absolute asnwer.
I hope this isn't for a school project.
Sub SendEMail()
Dim r As Integer
Dim cnt As Integer
Dim temphour As String
Dim emailstring As String
Dim OutApp As Object
Dim OutMail As Object
Dim lastrow As Integer
lastrow = 10
For cnt = 1 To lastrow
For r = 2 To 5 'colums fo rhourly data, make certain they match what you are looking at
'find the hours in the columns after email, if not 8.5 then get the email in colum 1 of the current line
temphour = Sheet1.cells(cnt, r)
If temphour <> "8.5" Then
emailstring = Sheet1.cells(cnt, 1) 'gets the email
'**************************************
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = emailstring
.CC = ""
.BCC = ""
.Subject = "Daily hours"
.Body = "Hours not 8.5 for " & WeekdayName(r - 1, 0, vbSunday)
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
'*******************************************
End If
Next r
Next cnt
End Sub
Have fun. If it doesn't work in your sheet, then make certain al of the cell references are coorect, as I am trying to wireframe it, and not give you an absolute asnwer.
TrowaD
Posts
2921
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
December 27, 2022
555
Aug 27, 2013 at 11:18 AM
Aug 27, 2013 at 11:18 AM
Hi JHakas,
Not sure what you want for an answer so let's give this a try.
When you run the code below, row 7 will be used to place some text to let you know to sent an e-mail.
Here is the code:
Best regards,
Trowa
Not sure what you want for an answer so let's give this a try.
When you run the code below, row 7 will be used to place some text to let you know to sent an e-mail.
Here is the code:
Sub RunMe()
Dim lCol, x As Integer
lCol = Cells(6, Columns.Count).End(xlToLeft).Column
x = 1
Do
If Cells(6, x).Value <> 8.5 Or _
Cells(6, x + 1).Value <> 8.5 Or _
Cells(6, x + 2).Value <> 8.5 Or _
Cells(6, x + 3).Value <> 8.5 Or _
Cells(6, x + 4).Value <> 8.5 Then
Cells(7, x).Value = "E-mail needs to be sent"
End If
x = x + 5
Loop Until x + 4 > lCol
End Sub
Best regards,
Trowa
I have a nested loop solution that formats emails. But I was not certain of the structure, so this is given:
A1-email@email.com B1-anotheremail@email.com etc....
A2-8.5 B2-8
A3-8.5 B2-8.5
A4-8.5 B2-8.5
A5-8.5 B2-8.5
A6-8.5 B2-8
The following code will generate an email for the Monday, and Friday for the User Anotheremail@email.com
Sub SendEMail()
Dim r As Integer
Dim cnt As Integer
Dim temphour As String
Dim emailstring As String
Dim OutApp As Object
Dim OutMail As Object
Dim lastrow As Integer
lastrow = Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column
For cnt = 1 To lastrow
For r = 2 To 5 'colums fo rhourly data, make certain they match what you are looking at
'find the hours in the columns after email, if not 8.5 then get the email in colum 1 of the current line
temphour = Sheet1.Cells(r, cnt)
If temphour <> "8.5" Then
emailstring = Sheet1.Cells(1, cnt) 'gets the email
'MsgBox (emailstring)
'**************************************
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = emailstring
.CC = ""
.BCC = ""
.Subject = "Daily hours"
.Body = "Hours not 8.5 for " & WeekdayName(r, 0, vbSunday)
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
'*******************************************
End If
Next r
Next cnt
End Sub
A1-email@email.com B1-anotheremail@email.com etc....
A2-8.5 B2-8
A3-8.5 B2-8.5
A4-8.5 B2-8.5
A5-8.5 B2-8.5
A6-8.5 B2-8
The following code will generate an email for the Monday, and Friday for the User Anotheremail@email.com
Sub SendEMail()
Dim r As Integer
Dim cnt As Integer
Dim temphour As String
Dim emailstring As String
Dim OutApp As Object
Dim OutMail As Object
Dim lastrow As Integer
lastrow = Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column
For cnt = 1 To lastrow
For r = 2 To 5 'colums fo rhourly data, make certain they match what you are looking at
'find the hours in the columns after email, if not 8.5 then get the email in colum 1 of the current line
temphour = Sheet1.Cells(r, cnt)
If temphour <> "8.5" Then
emailstring = Sheet1.Cells(1, cnt) 'gets the email
'MsgBox (emailstring)
'**************************************
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = emailstring
.CC = ""
.BCC = ""
.Subject = "Daily hours"
.Body = "Hours not 8.5 for " & WeekdayName(r, 0, vbSunday)
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
'*******************************************
End If
Next r
Next cnt
End Sub
Thanks ac3mark for the Code !!!! A Real help for me ..
I have a different format in which both times parse through colunms .
A1-email@email G6-anotheremail@email
A6-8.5,B6-8.5,C6-8.5,D6-8.5,E6-8 G6-8.5,H6-8.5,I-8.5,J-8.5,K-8.5
In the above case email should go anotheremail@email , I did some changes to the above to suit the condition but getting problem. Mail was sent for both A1 and G6 .
Seems to be initialization problem with variable "temphour" .
lastrow = Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column
For cnt = 1 To lastrow
For r = 1 To 5
temphour = Sheet1.Cells(6, r)
If temphour <> "8.5" Then
emailstring = Sheet1.Cells(1, cnt)
If emailstring Like "*@*" Then
'**************************************
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = emailstring
.CC = ""
.BCC = ""
.Subject = "Daily hours"
'.Body = "Hours not 8.5 for " & WeekdayName(r, 0, vbSunday)
.Body = "Hours not 8.5 for this week"
.Save
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
'*******************************************
End If
End If
Next r
Next cnt
End Sub
I have a different format in which both times parse through colunms .
A1-email@email G6-anotheremail@email
A6-8.5,B6-8.5,C6-8.5,D6-8.5,E6-8 G6-8.5,H6-8.5,I-8.5,J-8.5,K-8.5
In the above case email should go anotheremail@email , I did some changes to the above to suit the condition but getting problem. Mail was sent for both A1 and G6 .
Seems to be initialization problem with variable "temphour" .
lastrow = Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column
For cnt = 1 To lastrow
For r = 1 To 5
temphour = Sheet1.Cells(6, r)
If temphour <> "8.5" Then
emailstring = Sheet1.Cells(1, cnt)
If emailstring Like "*@*" Then
'**************************************
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = emailstring
.CC = ""
.BCC = ""
.Subject = "Daily hours"
'.Body = "Hours not 8.5 for " & WeekdayName(r, 0, vbSunday)
.Body = "Hours not 8.5 for this week"
.Save
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
'*******************************************
End If
End If
Next r
Next cnt
End Sub
Didn't find the answer you are looking for?
Ask a question
Good Morning,
I have came up with this...and thank you to Ambucias for restoring the messages.
Sub SendEMail()
Dim r As Integer
Dim cnt As Integer
Dim temphour As String
Dim emailstring As String
Dim OutApp As Object
Dim OutMail As Object
Dim lastrow As Integer
lastrow = Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column
For cnt = 1 To lastrow
For r = 2 To 5 'colums fo rhourly data, make certain they match what you are looking at
'find the hours in the columns after email, if not 8.5 then get the email in colum 1 of the current line
temphour = Sheet1.Cells(r, cnt)
If temphour <> "8.5" Then
emailstring = Sheet1.Cells(1, cnt) 'gets the email
'MsgBox (emailstring)
'**************************************
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = emailstring
.Subject = "Daily hours"
.Body = "Hours not 8.5 for " & WeekdayName(r, 0, vbSunday)
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
'*******************************************
End If
Next r
Next cnt
End Sub
I have came up with this...and thank you to Ambucias for restoring the messages.
Sub SendEMail()
Dim r As Integer
Dim cnt As Integer
Dim temphour As String
Dim emailstring As String
Dim OutApp As Object
Dim OutMail As Object
Dim lastrow As Integer
lastrow = Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column
For cnt = 1 To lastrow
For r = 2 To 5 'colums fo rhourly data, make certain they match what you are looking at
'find the hours in the columns after email, if not 8.5 then get the email in colum 1 of the current line
temphour = Sheet1.Cells(r, cnt)
If temphour <> "8.5" Then
emailstring = Sheet1.Cells(1, cnt) 'gets the email
'MsgBox (emailstring)
'**************************************
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = emailstring
.Subject = "Daily hours"
.Body = "Hours not 8.5 for " & WeekdayName(r, 0, vbSunday)
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
'*******************************************
End If
Next r
Next cnt
End Sub
The above code is for the following structure:
1A-email@email.com 1B-anotheremail@email.com
2a-8.5 2b-8
3a-8.5 3b-8.5
4a-8 4b-8.5
5a-8.5 5b-8.5
6a-8.5 6b-8
Based on the example, the code will start an email for User email@email.com for 8 hour on Wednesday (4A), and User anotheremail@email.com for 8 hours on Monday (2B), and 8 hours on Friday (6B).
I hope this helps.
1A-email@email.com 1B-anotheremail@email.com
2a-8.5 2b-8
3a-8.5 3b-8.5
4a-8 4b-8.5
5a-8.5 5b-8.5
6a-8.5 6b-8
Based on the example, the code will start an email for User email@email.com for 8 hour on Wednesday (4A), and User anotheremail@email.com for 8 hours on Monday (2B), and 8 hours on Friday (6B).
I hope this helps.
