VBA code for Audit schedule email-weekly

Hello,

Can anyone help me with the VBA code for the following problem?

There are 30 candidates in our department who need an email reminder about the upcoming audit schedule.

Can any one give me the code for sending auto email from Excel?

If the current week is 21 , I want to send email to the people who have audit in the week 22. Sample excel sheet is attached.


Hense

Hi,

You can check the link http://www.d i c k s-clicks.com/excel/olSending.htm for the code to send the email.
You will have to loop through the name of the people using and For loop and add it in the To/CC list.
Do let me know incase you need more help.

Thanks,
Deepal

Yes I have the code to send to email. But I need the code for conditional loop.

Hi,

I assume you need to send the email to only those people who have 1 marked in the next week.
1. For clarity move the current week cell to the top rows instead of it being after the names list.
2. You need to find the total number of people rows that will define your database.

Please Login or Register  to view this content.

5. Next week can be calculated in two ways.
a.

Please Login or Register  to view this content.

b.

Please Login or Register  to view this content.

4. loop through the email address link and call the send email function.

Please Login or Register  to view this content.

Hope this helps.

Thanks,
Deepal

I did not use your codes exactly but was a good help to get some ideas.

Finally I made it something like below.May not be very strong logic but it serve the purpose.

Sub Schedule()
'
'
'

'
Sheets("Email").Select
Cells.Select
Selection.ClearContents
Dim xyz
Sheets("Schedule").Select 'Select the sheet Schedule
Application.Goto Reference:="R25C3" ' This where week number is stored
xyz = ActiveCell.Value + 6 ' add the first 5 column + 1 for next week


Cells.Find(What:=xyz, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate ' Using find function to identify the next week

Application.CutCopyMode = False
ActiveCell.Select
If ActiveSheet.AutoFilterMode = True Then
ActiveSheet.AutoFilterMode = False
End If
Selection.AutoFilter


ActiveSheet.Range("$A$5:$BD$10").AutoFilter Field:=xyz, Criteria1:="<>" 'Filter the actice column that contain 1
Range("D2:D20").Select
Selection.Copy ' copy the emails
Sheets("Email").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("Schedule").Select
Application.CutCopyMode = False
ActiveSheet.ShowAllData
Selection.AutoFilter

Call Email ' call email
End Sub


Sub Email()

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Sheets("Email").Select
For Each cell In Columns("A").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" Then
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next

With OutMail
.To = cell.Value
.Cc = "[email protected]"
.Subject = "Audit Reminder"
.Body = "Hello " _
& vbNewLine & vbNewLine & _
"You are requested to conduct the audit in the coming week." & _
"The details are available in the attachment" _
& vbNewLine & vbNewLine & _
" If you need any assistance, please contact Mr. ------ on extn --------." _
& vbNewLine & vbNewLine & _
"Regards"



.Attachments.Add ("\\C\auditschedule.xlsm") 'add attachment





.Send
End With
On Error GoTo 0

Set OutMail = Nothing
End If
Next cell

cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True

End Sub