Excel help

[hussein_elsayed]

Dears,

Could you please help me regarding the attached sheet as i want to send a recurrent email to every employee with his salary through the excel.

N.B: Sheet password 123

Thanks

[#2]

@hussein_elsayed 

Here is a macro. Don't forget to save the workbook as a macro-enabled workbook (*.xlsm).

Sub SendMessages()
    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim ws3 As Worksheet
    Dim r As Long
    Dim m As Long
    Application.ScreenUpdating = False
    Set wb1 = ThisWorkbook
    Set ws1 = wb1.Worksheets("Master Sheet ")
    Set ws2 = wb1.Worksheets("Sheet1")
    m = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row
    For r = 9 To m
        If ws1.Range("V" & r).Value <> "" Then
            ws2.Range("A4").Value = ws1.Range("B" & r).Value
            ws2.Copy
            Set wb2 = ActiveWorkbook
            Set ws3 = wb2.Worksheets(1)
            ws3.Unprotect Password:="123"
            With ws3.UsedRange
                .Value = .Value
            End With
            ws3.Protect Password:="123"
            wb2.SendMail Recipients:=ws1.Range("V" & r).Value, Subject:="Salary Specification"
            wb2.Close SaveChanges:=False
        End If
    Next r
    Application.ScreenUpdating = True
End Sub

[#3]

@Hans Vogelaar 

Thanks you Mr. Hans

is there any way to send the emails without appear the attached screen as i have to click allow in every line in the list.

thanks in advance

[#4]

@hussein_elsayed 

The following version works best if Outlook is already running when you start the macro,

Sub SendMessages()
    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim ws3 As Worksheet
    Dim r As Long
    Dim m As Long
    Dim objOL As Object
    Dim objMsg As Object
    Dim f As Boolean
    Dim sFile As String
    Application.ScreenUpdating = False
    On Error Resume Next
    Set objOL = GetObject(Class:="Outlook.Application")
    If objOL Is Nothing Then
        f = True
        Set objOL = CreateObject(Class:="Outlook.Application")
    End If
    On Error GoTo ErrHandler
    Set wb1 = ThisWorkbook
    Set ws1 = wb1.Worksheets("Master Sheet ")
    Set ws2 = wb1.Worksheets("Sheet1")
    m = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row
    For r = 9 To m
        If ws1.Range("V" & r).Value <> "" Then
            ws2.Range("A4").Value = ws1.Range("B" & r).Value
            ws2.Copy
            Set wb2 = ActiveWorkbook
            Set ws3 = wb2.Worksheets(1)
            ws3.Unprotect Password:="123"
            With ws3.UsedRange
                .Value = .Value
            End With
            ws3.Protect Password:="123"
            sFile = ws1.Range("B" & r).Value & ".xlsx"
            wb2.SaveAs Filename:=sFile
            wb2.Close SaveChanges:=False
            Set objMsg = objOL.CreateItem(0)
            objMsg.Subject = "Salary Specification"
            objMsg.Body = "Please find the salary specification attached to this message"
            objMsg.To = ws1.Range("V" & r).Value
            objMsg.Attachments.Add sFile
            objMsg.Send
            Kill sFile
        End If
    Next r
ExitHandler:
    On Error Resume Next
    If f Then
        objOL.Quit
    End If
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
    Application.ScreenUpdating = True
End Sub

[#5]

thank you it works will, but for the embty emails it send an emails for them with the first.
is there any way to send the line that including emails only

[#6 · Accepted solution]

@hussein_elsayed 

The sample workbook has column V for email address. The code checks that this column is not empty:

If ws1.Range("V" & r).Value <> "" Then

So it should not create an email message for rows that have no email address.

[#7]

Thank you Mr. Hans

[#8]

@Hans Vogelaar 

Dear Mr. Hans,

Could you please help me for the attached issue as i did some modification in the master data sheet (adding culumns and rearrange some of them) but it shows error when i tried to run the macro.

and sorry for send my issue in a private message.

Thanks in advance

[#9]

@hussein_elsayed 

See the attached version.

[#10]

Thank you Mr. Hans it works well.
Could you please show me where are the mistakes as i just change the new column for the Email
in the code screen

[#11]

@hussein_elsayed 

You modified the code correctly.

As I wrote in my PM, I added a folder path for the attachments; that appears to prevent the error.

[#12]

Thank you so much Mr. Hans