Страницы: 1
RSS
Автоматическая рассылка писем из Excel через OUTLOOk
 
Добрый день!  
 
Сделал следующую штуку:    
в EXCEL с помощью VBA рассылаются письма через OUTLOOK.    
Макрос рассылки запускается при открытии файла.  
файл открывается с помощью назначенных заданий windows.  
 
Но каждый раз при отправке письма через макрос OUTLOOK спрашивает разрешения на отправку. Это неудобно.    
Хотелось бы, чтобы OUTLOOK не спрашивал разрешения, а отправлял письма сразу (например, сказать OUTLOOK, что данный файл EXCEL не представляет угрозы и ему можно доверять).  
 
Есть ли какие-нибудь способы это сделать?  
 
Спасибо!
 
Матвей, Вы бы для начала в "Приемы" заглянули, а уж потом темы создавали, если чего непонятно... <BR>http://www.planetaexcel.ru/tip.php?aid=156
 
{quote}{login=Юрий М}{date=07.10.2010 01:45}{thema=}{post}Матвей, Вы бы для начала в "Приемы" заглянули, а уж потом темы создавали, если чего непонятно... <BR>http://www.planetaexcel.ru/tip.php?aid=156{/post}{/quote}  
 
Спасибо, Юрий! Именно так я и сделал: все описанное в 1-м посте реализовано с помощью указанного "Приема"  
 
Вопрос в том, как при использовании 3-го метода уйти от "навязчивых" вопросов OUTLOOK при отправке (Сообщение во вложении)
 
Аналогичная тема уже была... зайдите на сайт специалиста по этому делу - может чего и найдётся: http://www.rondebruin.nl/index.html
 
Тут ещё: <EM>http://excel-vba.ru/index.php?file=MyAddin_Send_Mail</EM>
 
Здравствуйте, участники форума. Необходимо организовать рассылку почты посредством макроса неограниченному кругу участников. Причем эти участники должны добавляться в поле "скрытая копия". текст письма для всех одинаковый. Вложение в письмо опционально.  
На форуме ничего подходящего не нашел, а мои начальные знания не позволяют усовершенствовать, то что я нашел. Поэтому прошу помощи. Файл прилагаю.
 
Есть ли люди добрыя на этом ресурсе?
 
Давно интересует вопрос: как средствами VBA в папке "Отправленные" Outlook 2007 проверить наличие отправленного сообщения по имени вложенного файла? Искал в Интернете, но безрезультатно. Может кто-нибудь сможет что-то  подсказать?
 
Спасибо, The_Prist. Буду разбираться с кодом. Что бы я делал без вас?)))  
 
 
{quote}{login=The_Prist}{date=12.10.2010 04:26}{thema=Re: Видимо про меня тут забыли(((}{post}{quote}{login=Дима Вэ.}{date=12.10.2010 04:14}{thema=Видимо про меня тут забыли(((}{post}Есть ли люди добрыя на этом ресурсе?{/post}{/quote}  
Скрытые получатели добавляются так:  
.BСС = cell.Value  
 
Еще у Вас там незакрытый цикл и не закрытое If  
 
Короче, код такой:  
Sub SendMail()  
   Dim OutApp As Object  
   Dim OutMail As Object  
   Dim cell As Range  
 
   'создаем новое пустое сообщение в Outlook  
   Application.ScreenUpdating = False  
   Set OutApp = CreateObject("Outlook.Application")  
   OutApp.Session.Logon  
   For Each cell In Columns("A").Cells.SpecialCells(xlCellTypeConstants)    'добавил  
       If cell.Value Like "?*@?*.?*" And _  
          Application.WorksheetFunction.CountA(cell) > 0 Then  
           Set OutMail = OutApp.CreateItem(0)  
           On Error GoTo cleanup  
           Set OutMail = OutApp.CreateItem(0)  
           On Error Resume Next  
           'заполняем его адрес, тему и т.д.  
           With OutMail  
               .To = cell.Value    'Range("A2:A5").Value  
               .Subject = Range("B2").Value  
               .Body = Range("C2").Value  
               .BCC = "realist91112@mail.ru"  
               .Attachments.Add Range("D2").Value  
               'вместо Send можно использовать Display, чтобы посмотреть сообщение перед отправкой  
               .Display  
           End With  
 
           On Error GoTo 0  
           Set OutMail = Nothing  
       End If  
   Next cell  
cleanup:  
   Set OutApp = Nothing  
   Application.ScreenUpdating = True  
End Sub{/post}{/quote}
 
Ошибка выскакивает на этапе  
 For Each cell In sh.Columns("A").Cells.SpecialCells(xlCellTypeConstants) 'добавил  
 
Наверное, я не закрыл цикл?  
 
{quote}{login=The_Prist}{date=12.10.2010 04:26}{thema=Re: Видимо про меня тут забыли(((}{post}{quote}{login=Дима Вэ.}{date=12.10.2010 04:14}{thema=Видимо про меня тут забыли(((}{post}Есть ли люди добрыя на этом ресурсе?{/post}{/quote}  
Скрытые получатели добавляются так:  
.BСС = cell.Value  
 
Еще у Вас там незакрытый цикл и не закрытое If  
 
Короче, код такой:  
Sub SendMail()  
   Dim OutApp As Object  
   Dim OutMail As Object  
   Dim cell As Range  
 
   'создаем новое пустое сообщение в Outlook  
   Application.ScreenUpdating = False  
   Set OutApp = CreateObject("Outlook.Application")  
   OutApp.Session.Logon  
   For Each cell In Columns("A").Cells.SpecialCells(xlCellTypeConstants)    'добавил  
       If cell.Value Like "?*@?*.?*" And _  
          Application.WorksheetFunction.CountA(cell) > 0 Then  
           Set OutMail = OutApp.CreateItem(0)  
           On Error GoTo cleanup  
           Set OutMail = OutApp.CreateItem(0)  
           On Error Resume Next  
           'заполняем его адрес, тему и т.д.  
           With OutMail  
               .To = cell.Value    'Range("A2:A5").Value  
               .Subject = Range("B2").Value  
               .Body = Range("C2").Value  
               .BCC = "realist91112@mail.ru"  
               .Attachments.Add Range("D2").Value  
               'вместо Send можно использовать Display, чтобы посмотреть сообщение перед отправкой  
               .Display  
           End With  
 
           On Error GoTo 0  
           Set OutMail = Nothing  
       End If  
   Next cell  
cleanup:  
   Set OutApp = Nothing  
   Application.ScreenUpdating = True  
End Sub{/post}{/quote}
 
{quote}{login=Дима Вэ.}{date=14.10.2010 08:14}{thema=Re: Re: Видимо про меня тут забыли(((}{post}Ошибка выскакивает на этапе  
 For Each cell In sh.Columns("A").Cells.SpecialCells(xlCellTypeConstants) 'добавил  
 
Наверное, я не закрыл цикл?{/post}{/quote}Я за Вас все циклы уже закрыл, если Вы не заметили. Скорее всего у Вас нет ячеек со значениями - либо только формулы. Замените на:  
For Each cell In sh.range(sh.cells(1,1),sh.cells(sh.rows.count).end(xlup))
 
Да я цикл не отличу от условия... Все равно код спотыкается на "For each cell..."  
Для каждого адреса формируется письмо отдельное, правильно? (судя по коду и циклам)... Мне достаточно, чтобы все получатели добавлялись в поле "Скрытая копия", т.е. достаточно одного письма на ввсех...  
 
{quote}{login=}{date=14.10.2010 10:01}{thema=Re: Re: Re: Видимо про меня тут забыли(((}{post}{quote}{login=Дима Вэ.}{date=14.10.2010 08:14}{thema=Re: Re: Видимо про меня тут забыли(((}{post}Ошибка выскакивает на этапе  
 For Each cell In sh.Columns("A").Cells.SpecialCells(xlCellTypeConstants) 'добавил  
 
Наверное, я не закрыл цикл?{/post}{/quote}Я за Вас все циклы уже закрыл, если Вы не заметили. Скорее всего у Вас нет ячеек со значениями - либо только формулы. Замените на:  
For Each cell In sh.range(sh.cells(1,1),sh.cells(sh.rows.count).end(xlup)){/post}{/quote}
 
{quote}{login=The_Prist}{date=14.10.2010 06:01}{thema=}{post}Зачем Вы выложили второй файл - не знаю. Вы даже не потрудились туда мой код вставить.  
Я вставил, проверил на ВАШЕМ файле свой код - все формируется. Почему не формируется у Вас - одному Вам известно.    
Какая хоть ошибка появляется?{/post}{/quote}  
 
С вашим кодом все в порядке. Вставил, работает. Это в моем, видимо, ошибка где-то.  
Ваш код не вставлял, а пытался доработать свой с учетом ваших замечаний.. вроде все похоже, но у меня неправильно. Спасибо вам.
 
Кстати, вот здесь я описывал способ отправки без Outlook: http://excel-vba.ru/index.php?file=Tips_Macro_SendMail  
 
 
The_Prist, я хотел используват этот код. Заполнил все поля и нажал: "Отправить письмо". Получается "Нет доступа к интернет". А интернет у мея есть. В чем может быт проблема?
 
Останавляется на команду '.Send' Ошибка: 'Транспорту не удалось подключиться к серверу' Понимаю что, что-то в моем комп. проблема. Но, что может быть, незнаю.
Страницы: 1
Читают тему
Наверх