Рассылка через Ms Outlook

On Error Resume Next
Kill "D:\emails.txt"
With Ñïèñîê2
For i = 0 To Ñïèñîê2.ListCount - 2
.SetFocus
.ListIndex = .ListIndex + 1
Open "D:\emails.txt" For Append As #1 'Îòêðûâàåì ôàéë äëÿ äîáàâëåíèÿ çàïèñè, ñ íîìåðîì êàíàëà 1
Print #1, .Column(3)
Close #1 'Çàêðûâàåì ôàéë
Next i
End With
 
Dim o_Mess As Object, v_Conf As String, email As String
v_Conf = "http://schemas.microsoft.com/cdo/configuration/"
Set o_Mess = CreateObject("CDO.Message")
Open "D:\emails.txt" For Input As #1
Do While Not EOF(1)
Line Input #1, email
With o_Mess
    .To = email
    .From = "ТУТ АДРЕС ПОЧТЫ"
    .Subject = "ÒÅÌÀ"
    .TextBody = "ÒÅËÎ ÑÎÎÁÙÅÍÈß"
With .Configuration.Fields
    .Item(v_Conf & "sendusing") = 2
    .Item(v_Conf & "smtpserver") = "smtp.mail.ru"
    .Item(v_Conf & "smtpauthenticate") = 1
    .Item(v_Conf & "sendusername") = "ТУТ АДРЕС ПОЧТЫ"
    .Item(v_Conf & "sendpassword") = "ТУТ ПАРОЛЬ ОТ ПОЧТЫ"
    .Item(v_Conf & "smtpserverport") = 25
    .Item(v_Conf & "smtpusessl") = False
    .Item(v_Conf & "smtpconnectiontimeout") = 60
    .Update
End With
    .send
End With
Loop
Close #1
Set o_Mess = Nothing

Dim o_Mess As Object, v_Conf As String, email As String
v_Conf = "http://schemas.microsoft.com/cdo/configuration/"
Set o_Mess = CreateObject("CDO.Message")
Open "D:\emails.txt" For Input As #1
Do While Not EOF(1)
Line Input #1, email
With o_Mess
    .To = email
    .From = "ВАШ E-MAIL"
    .Subject = "ТЕМА ПИСЬМА"
    .TextBody = "ТЕЛО ФАЙЛА"
With .Configuration.Fields
    .Item(v_Conf & "sendusing") = 2
    .Item(v_Conf & "smtpserver") = "smtp.mail.ru"
    .Item(v_Conf & "smtpauthenticate") = 1
    .Item(v_Conf & "sendusername") = "ВАШ E-MAIL"
    .Item(v_Conf & "sendpassword") = "ВАЩ ПАРОЛЬ"
    .Item(v_Conf & "smtpserverport") = 25
    .Item(v_Conf & "smtpusessl") = False
    .Item(v_Conf & "smtpconnectiontimeout") = 60
    .Update
End With
    .send
End With
Loop
Close #1
Set o_Mess = Nothing