Как сделать автоматическую рассылку?

Sub P1()
'Самоучитель: Слепцова Л.Д. Есть раздел по работе с MS Outlook.
'Подключаем объекты библиотеки Excel:
'Tools - References... - Microsoft Excel Object Library.
'С Excel будем работать через объектную переменную Эксель,
'которая и будет представлять собой сам Excel
'(имена переменных не должны совпать с именами объектов,
'иначе может быть ситуация, что компилятор примет переменную за объект).
Dim Эксель As Excel.Application
Dim Книга As Excel.Workbook
Dim Адреса As String, LastRow As Long
'Доступ к папкам осуществляется через объект NameSpace.
Dim СписокИмён As Outlook.NameSpace
Dim Входящие As Outlook.Folder 'в MS Outlook 2003 - As Outlook.MAPIFolder
Dim Письмо As Outlook.MailItem
Dim i As Long
'Всегда используется MAPI (др. нет - закрыли проект).
Set СписокИмён = GetNamespace("MAPI")
'Помещаем в объектную переменную Входящие папку Входящие.
'Папка Входящие всегда есть в наличии, поэтому доступ к ней
'осуществим с помощью следующей конструкции.
Set Входящие = СписокИмён.GetDefaultFolder(olFolderInbox)
'Проверяем, есть ли в папке Входящие письма, чтобы не было
'ошибки, если там вообще ничего нет.
If Входящие.Items.Count = 0 Then
    Exit Sub
    MsgBox "В папке Входящие нет писем", vbCritical
End If
'Рассмотрим ситуацию, что книга с электронными адресами открыта
'и является активной. Если книга открыта, то запускать программу
'Excel не надо, а подсоединимся к уже запущенной программе Excel.
Set Эксель = GetObject(Class:="Excel.Application")
Set Книга = Эксель.ActiveWorkbook
'Предполагается, что каждый электронный адрес находится в отдельной ячейке.
'В моём случае электронные адреса будут находиться
'на первом листе в первом столбце.
'Формируем переменную, содержающую все электронные адреса
'из  Excel. К каждому адресу надо добавлять точку с запятой.
'Определяем последнюю заполненную ячейку в первом столбце.
LastRow = Книга.ActiveSheet.Cells(Книга.ActiveSheet.Rows.Count, 1).End(xlUp).Row
For i = 1 To LastRow Step 1
    Адреса = Адреса & Книга.ActiveSheet.Cells(i, 1).Value & ";"
Next i
'Помещаем в переменную Письмо последнее письмо в папке Входящие.
Set Письмо = Входящие.Items(Входящие.Items.Count)
'Указываем адреса.
Письмо.To = Адреса
'Если в копию надо, то:
'Письмо.CC = Адреса
'После того, как строка сформирована с адресами, отправляем письмо.
Письмо.Send
MsgBox "Пересылка письма завершена", vbInformation
End Sub

Sub P1()
Dim ПространствоИмён As Outlook.NameSpace
Dim Входящие As Outlook.Folder 'в MS Outlook 2003 - As Outlook.MAPIFolder
Dim Письмо As Outlook.MailItem
Dim Массив() As String
Dim i As Long
Set ПространствоИмён = GetNamespace("MAPI")
Set Входящие = ПространствоИмён.GetDefaultFolder(olFolderInbox)
If Входящие.Items.Count = 0 Then
    MsgBox "В папке Входящие нет писем", vbCritical
    Exit Sub
End If
Set Письмо = Входящие.Items(Входящие.Items.Count)
'В конце каждой строки в тексте письма есть два невидимых
'символа, коды которых по ASCII: 13 и 10.
'Основываясь на них создадим массив с помощью
'встроенной функци VBA: Split. Затем этот массив
'вернём обратно в письмо, но без пяти первых элементов.
Массив = Split(Письмо.Body, Chr(13) & Chr(10))
'Очищаем текст письма.
Письмо.Body = ""
'Заполняем текс письма обратно.
'Порядковый номер первого элемента массива ноль.
For i = 5 To UBound(Массив) Step 1
    Письмо.Body = Письмо.Body & Массив(i) & Chr(13) & Chr(10)
Next i
End Sub