Excel help

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