Отправка файла через Outlook при условии его нахождения в папке

[Gvaridos]

всё отлично, работает. только при отправке выходит плашка, где нужно нажимать ОК, Надо как-то от неё избавиться, а то нету должного автоматизма!(((
Кто поможет?

(добавлено модератором - может, кому пригодится)

Посмотрите самый простой способ, как организовать отправку почты (рассылку писем)
(с использованием программы заполнения документов по шаблонам, с последующей отправке по почте)

В программе есть возможность формировать письма по шаблону (с подстановкой данных из таблицы Excel),
прикреплять сформированные документы и файлы из выбранной папки, и много других возможностей.

[doober]

Сообщение от Gvaridos

всё отлично, работает. только при отправке выходит плашка, где нужно нажимать ОК, Надо как-то от неё избавиться, а то нету должного автоматизма!(((
Кто поможет?

Поможет CDO
Отправит автоматом

[Gvaridos]

Sub Рассылка2()
pt = "\\Depo\RsBank51\Reports\Отчёты бэк-офиса\3173-229\"
fn = "m 3173-229 " & Format(Now - 1, "DD.MM.YY") & ".xls"
On Error Resume Next
Application.DisplayAlerts = False
Workbooks.Open pt & fn
If Err.Number > 0 Then
Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1) = fn & " - не найден, ошибка:" & Err.Number
Else
Application.Run "CDO"
End If
Application.DisplayAlerts = True
End Sub

Sub CDO()

Dim WB As Workbook
Dim ind As Integer
ind = ActiveSheet.Index
Application.DisplayAlerts = False
Set WB = Workbooks.Add ' создаём новую книгу
Dim li As Long
Application.DisplayAlerts = False
For n = ind To 1 Step -1
ThisWorkbook.Sheets(n).Copy Before:=WB.Sheets(1)
Next
WB.SaveAs Application.DefaultFilePath & Application.PathSeparator & "На_Отпраку.xls", xlNormal
WB.Close False
Application.DisplayAlerts = True
Set cdoConfig = CreateObject("CDO.Configuration")

With cdoConfig.Fields
.Item(cdoSendUsingMethod) = cdoSendUsingPort

.Item(cdoSMTPAuthenticate) = 1
.Item(cdoSMTPServer) = "smtp.yandex.ru" ' Ваш SMTPServer
.Item(cdoSendUserName) = "starosta11a" ' Ваша учетная запись
.Item(cdoSendPassword) = "мой пароль" ' Ваш пароль
.Update
End With

Set cdoMessage = CreateObject("CDO.Message")

With cdoMessage
On Error Resume Next

Set .Configuration = cdoConfig
.From = "starosta11a@yandex.ru" ' отправитель

.To = "pee@ntb.volga.ru" 'Получатель.Если не один то через запятую
.Subject = "Отчёт о совершенных сделках"
.TextBody = "Добрый день Василий Александрович! Предоставляем вам, отчет брокера по операциям за предыдущий торговый день. С уважением, клиентский отдел УФО ОАО НТБ. Тел. 8(8482)952816"
.Attachments.Add ("\\Depo\RsBank51\Reports\Отчёты бэк-офиса\3173-229\m 3173-229 " & Format(Date - 1, "dd.mm.yy") & ".xls")
'.AddAttachment Application.DefaultFilePath & Application.PathSeparator & "На_Отпраку.xls" ' Добавляем файл
.Send
End With
If Err.Number = -2147220973 Then
MsgBox ("Отсутствует связь с интернетом")
End If
If Err.Number = -2147220975 Then
MsgBox ("SMTP сервер ответил отказом")
End If
Set cdoMessage = Nothing
Set cdoConfig = Nothing

If Err.Number = 0 Then
MsgBox ("Письмо отправлено")
End If
Kill Application.DefaultFilePath & Application.PathSeparator & "На_Отпраку.xls"
End Sub




НЕ РАБОТАЕТ CDO!((( ПОМОГИТЕ ПОДПРАВИТЬ КОД?

[doober]

Код рабочий.сейчас проверил со своими данными
Если такое сообщение

,значит не правильный пароль

Если такое


Посмотреть здесь.что надо сделать

[Gvaridos]

Вот такая ошибка выходит...
что подскажете?

[Gvaridos]

Всё сделал... вроде сработало, но письмо не приходит.
Что ещё может быть?

[doober]

Щлите файл оригинал на почту strojservis собака nxt.ru
А потом уже смените свой пароль,или создайте новый анкаут,выкладывайте файл с паролем на мыло.
По другому не проверишь

[Gvaridos]

отправил на мыло