Добрый день, форумчане, Помогите, пожалуйста в решении производственной задачи. Необходим макрос рассылающий сообщения по адресатам ежедневно в 00:10:00 с учетом особенностей заполнения файла. Файл в приложении. Особенности: 1. листов много и раз в неделю добавляется еще один с аналогичной таблицей. 2. Макрос должен: - обращая внимание на текущую дату искать даты, которые на 2 дня позже и забирать в сообщение информацию "ТекстХ" и собственно саму дату. - адресаты для сообщений в файле. 3. рассылку делать в 00:10:00
Одновременно создавал тему в разделе "работа" My WebPage Ни кто не откликнулся. Помогите пазязя)))
PS: Просьба прикреплять файлы в архиве. (рабочий антивирус, который выключить не могу блокирует содержащийся в файлах код)
Добрый день, форумчане, Помогите, пожалуйста в решении производственной задачи. Необходим макрос рассылающий сообщения по адресатам ежедневно в 00:10:00 с учетом особенностей заполнения файла. Файл в приложении. Особенности: 1. листов много и раз в неделю добавляется еще один с аналогичной таблицей. 2. Макрос должен: - обращая внимание на текущую дату искать даты, которые на 2 дня позже и забирать в сообщение информацию "ТекстХ" и собственно саму дату. - адресаты для сообщений в файле. 3. рассылку делать в 00:10:00
Одновременно создавал тему в разделе "работа" My WebPage Ни кто не откликнулся. Помогите пазязя)))
PS: Просьба прикреплять файлы в архиве. (рабочий антивирус, который выключить не могу блокирует содержащийся в файлах код)konstantinp
Ну вот Вам в качестве первого приближения решения. Я придал информации иной вид на втором листе (через формулы). Этот вид ("view") мне представляется более удобным для цикла рассылки писем. Макрос для отправки написан "в лоб"(см. под спойлером), без излишеств, требует подтверждения отправки каждого письма (это, конечно, не то, чего хочется, но это первое приближение). В Outlook 2010 можно попробовать отключить предупреждение и необходимость его подтверждения. У меня не получилось, так как доступ к этой возможности закрыт корпоративным сисадмином.
[vba]
Code
Sub mySendMail()
Dim outApp As Outlook.Application Dim outMail As Outlook.MailItem Dim cell As Range
Set outApp = New Outlook.Application
For Each cell In [ДляОтправки!I2:I133]
If cell <> "" Then Set outMail = outApp.CreateItem(olMailItem) With outMail .To = cell.Offset(0, -1).Value .Subject = cell.Value .Body = cell.Value
.Send End With Set outMail = Nothing End If
Next
Set outApp = Nothing
End Sub
[/vba]
Ну вот Вам в качестве первого приближения решения. Я придал информации иной вид на втором листе (через формулы). Этот вид ("view") мне представляется более удобным для цикла рассылки писем. Макрос для отправки написан "в лоб"(см. под спойлером), без излишеств, требует подтверждения отправки каждого письма (это, конечно, не то, чего хочется, но это первое приближение). В Outlook 2010 можно попробовать отключить предупреждение и необходимость его подтверждения. У меня не получилось, так как доступ к этой возможности закрыт корпоративным сисадмином.
[vba]
Code
Sub mySendMail()
Dim outApp As Outlook.Application Dim outMail As Outlook.MailItem Dim cell As Range
Set outApp = New Outlook.Application
For Each cell In [ДляОтправки!I2:I133]
If cell <> "" Then Set outMail = outApp.CreateItem(olMailItem) With outMail .To = cell.Offset(0, -1).Value .Subject = cell.Value .Body = cell.Value
Сделаем следующий шаг. Сегодня мы научимся запускать пакетную рассылку из Outlook без подтверждения отправки каждого сообщения и в назначенный заранее момент времени.
Для работы без подтверждения нам понадобится библиотека Redemption (dll). Я уже как-то несколько лет назад беседовал о ней здесь: http://www.axforum.info/forums/showthread.php?p=170203#post170203 , можно ознакомиться, чтобы понимать зачем она нужна. Кстати, "redemption" по-английски означает "освобождение", а также "выкуп", "исправление", "искупление".
Как следует из ссылки, саму dll-ку можно скачать здесь: http://www.dimastr.com/redemption/download.htm . Нужно взять версию для разработчиков (Developer) - она единственная бесплатная. Правда, она показывает некое сообщение о соглашении типа "I agree". Это сообщение пока показалось мне один раз - при самом первом запуске макроса с использованием Redemption. Пока не знаю, будет ли еще; пока просто заспамливаю свой ящик в тестовом режиме, отправляя в автомате макросом каждые 10 минут по 26 писем (p.s. процесс успешно крутился несколько часов - сообщение больше не показывалось).
Развернув скачанный архив, надо запустить Install.exe (желательно также предварительно ознакомиться с файлом readme.txt). Да! Для установки понадобятся права администратора на своей машине.
Далее пока алгоритм такой - для тестирования: 1. Загружаем в Excel приложенную рабочую книгу (библиотека Redemption должна быть уже развернута до этого). 2. В диапазон Листа1, где указаны e-mail адреса, прописываем что-нибудь реальное, например, свой собственный адрес (ну чтобы письма реально посылались: от себя - себе). 3. Находим в редакторе VB макрос setTimeToRun и прописываем в скобки TimeSerial момент времени некоторого ближайшего будущего (сейчас там 15:30). 4. Однократно запускаем этот макрос setTimeToRun. 5. Ждём (не закрывая файла). 6. Каждые 10 минут в почтовый ящик приходит пачка писем (26 штук - по числу непустых строк в столбце I второго листа).
Для беглого ознакомления текст макросов также дублирую ниже под спойлером.
[vba]
Code
Sub setTimeToRun() Application.OnTime TimeSerial(15, 30, 0), "mySendMailByRedemption" '15:30:00 End Sub
Sub mySendMailByRedemption()
'Перед запуском в редакторе VB в меню Tools\References установить ссылку (включить галку) 'на библиотеку Redemption Outlook and MAPI COM Library
'взять бесплатную версию для разработчиков можно отсюда: 'http://www.dimastr.com/redemption/download.htm
'после установки на компьютер она по умолчанию лежит здесь: 'C:\Program Files\Redemption\Redemption.dll
Dim outApp As Outlook.Application Dim outMail As Outlook.MailItem Dim redSafeMale As Redemption.SafeMailItem Dim cell As Range
Set outApp = New Outlook.Application
For Each cell In ThisWorkbook.Worksheets("ДляОтправки").Range("I2:I133") If cell <> "" Then
Set outMail = outApp.CreateItem(olMailItem) With outMail .To = cell.Offset(0, -1).Value .Subject = cell.Value .Body = cell.Value End With
Set redSafeMale = New Redemption.SafeMailItem With redSafeMale .Item = outMail .Send End With
Set redSafeMale = Nothing Set outMail = Nothing End If Next
Set outApp = Nothing
'задаем время следующего исполнения этой процедуры - только для целей тестирования! Application.OnTime Now + TimeSerial(0, 10, 0), "mySendMailByRedemption" 'время - сейчас + 10 минут
End Sub
[/vba]
Сделаем следующий шаг. Сегодня мы научимся запускать пакетную рассылку из Outlook без подтверждения отправки каждого сообщения и в назначенный заранее момент времени.
Для работы без подтверждения нам понадобится библиотека Redemption (dll). Я уже как-то несколько лет назад беседовал о ней здесь: http://www.axforum.info/forums/showthread.php?p=170203#post170203 , можно ознакомиться, чтобы понимать зачем она нужна. Кстати, "redemption" по-английски означает "освобождение", а также "выкуп", "исправление", "искупление".
Как следует из ссылки, саму dll-ку можно скачать здесь: http://www.dimastr.com/redemption/download.htm . Нужно взять версию для разработчиков (Developer) - она единственная бесплатная. Правда, она показывает некое сообщение о соглашении типа "I agree". Это сообщение пока показалось мне один раз - при самом первом запуске макроса с использованием Redemption. Пока не знаю, будет ли еще; пока просто заспамливаю свой ящик в тестовом режиме, отправляя в автомате макросом каждые 10 минут по 26 писем (p.s. процесс успешно крутился несколько часов - сообщение больше не показывалось).
Развернув скачанный архив, надо запустить Install.exe (желательно также предварительно ознакомиться с файлом readme.txt). Да! Для установки понадобятся права администратора на своей машине.
Далее пока алгоритм такой - для тестирования: 1. Загружаем в Excel приложенную рабочую книгу (библиотека Redemption должна быть уже развернута до этого). 2. В диапазон Листа1, где указаны e-mail адреса, прописываем что-нибудь реальное, например, свой собственный адрес (ну чтобы письма реально посылались: от себя - себе). 3. Находим в редакторе VB макрос setTimeToRun и прописываем в скобки TimeSerial момент времени некоторого ближайшего будущего (сейчас там 15:30). 4. Однократно запускаем этот макрос setTimeToRun. 5. Ждём (не закрывая файла). 6. Каждые 10 минут в почтовый ящик приходит пачка писем (26 штук - по числу непустых строк в столбце I второго листа).
Для беглого ознакомления текст макросов также дублирую ниже под спойлером.
[vba]
Code
Sub setTimeToRun() Application.OnTime TimeSerial(15, 30, 0), "mySendMailByRedemption" '15:30:00 End Sub
Sub mySendMailByRedemption()
'Перед запуском в редакторе VB в меню Tools\References установить ссылку (включить галку) 'на библиотеку Redemption Outlook and MAPI COM Library
'взять бесплатную версию для разработчиков можно отсюда: 'http://www.dimastr.com/redemption/download.htm
'после установки на компьютер она по умолчанию лежит здесь: 'C:\Program Files\Redemption\Redemption.dll
Dim outApp As Outlook.Application Dim outMail As Outlook.MailItem Dim redSafeMale As Redemption.SafeMailItem Dim cell As Range
Set outApp = New Outlook.Application
For Each cell In ThisWorkbook.Worksheets("ДляОтправки").Range("I2:I133") If cell <> "" Then
Set outMail = outApp.CreateItem(olMailItem) With outMail .To = cell.Offset(0, -1).Value .Subject = cell.Value .Body = cell.Value End With
Set redSafeMale = New Redemption.SafeMailItem With redSafeMale .Item = outMail .Send End With
Set redSafeMale = Nothing Set outMail = Nothing End If Next
Set outApp = Nothing
'задаем время следующего исполнения этой процедуры - только для целей тестирования! Application.OnTime Now + TimeSerial(0, 10, 0), "mySendMailByRedemption" 'время - сейчас + 10 минут
Gustav, Спасибо большое. Щас найду админа раб очих станций и попробую)
Не выходит. Галка на этот dll стоит http://i051.radikal.ru/1209/3a/6171299a915c.jpg ругается на отсутствие библиотеки outlook14.0 ее можно скачать? (что то не найду ) у меня 2007 офис, нужно на 2010 перейти?
Gustav, Спасибо большое. Щас найду админа раб очих станций и попробую)
Просто отключите эту строчку с 14.0 и, если у Вас 2007, то найдите и включите "Microsoft Outlook 12.0 Object Library".
Либо откажитесь от явной типизации объектов (тогда включать эту ссылку вообще не надо) и придайте трём операторам следующий вид: [vba]
Code
Dim outApp As Object 'Outlook.Application Dim outMail As Object 'Outlook.MailItem
Set outApp = CreateObject("Outlook.Application") 'New Outlook.Application
[/vba] Правда, в этом случае Вы не сможете пользоваться удобством опции "Auto List Members" (выпадающий список методов и свойств, возникающий в редакторе VB, когда ставите точку после имени объекта). Однако, если Вы не особо собираетесь дальше сами программировать этот макрос, то отсутствие этой опции не так уж и важно.
Quote (konstantinp)
ругается на отсутствие библиотеки outlook14.0
Просто отключите эту строчку с 14.0 и, если у Вас 2007, то найдите и включите "Microsoft Outlook 12.0 Object Library".
Либо откажитесь от явной типизации объектов (тогда включать эту ссылку вообще не надо) и придайте трём операторам следующий вид: [vba]
Code
Dim outApp As Object 'Outlook.Application Dim outMail As Object 'Outlook.MailItem
Set outApp = CreateObject("Outlook.Application") 'New Outlook.Application
[/vba] Правда, в этом случае Вы не сможете пользоваться удобством опции "Auto List Members" (выпадающий список методов и свойств, возникающий в редакторе VB, когда ставите точку после имени объекта). Однако, если Вы не особо собираетесь дальше сами программировать этот макрос, то отсутствие этой опции не так уж и важно.Gustav
Очень давно, был написан макрос рассылки сообщения получателям, который выполнял следующую задачу: каждому получателю он отправлял нужный файл при этом содержание письма для всех получателей было одинаковым. Признаком является числовой код состоящий из 4 знаков (Например: 2222_АБВГД).
Раньше запускала без проблем. А теперь уже с первых строк выдает такие ошибки....
Файл можно посмотреть по ссылке... по другому не поняла как прикрепить
Очень нужно чтобы работало!
Спасибо!
Gustav, Добрый вечер!
Очень давно, был написан макрос рассылки сообщения получателям, который выполнял следующую задачу: каждому получателю он отправлял нужный файл при этом содержание письма для всех получателей было одинаковым. Признаком является числовой код состоящий из 4 знаков (Например: 2222_АБВГД).
Раньше запускала без проблем. А теперь уже с первых строк выдает такие ошибки....
А теперь уже с первых строк выдает такие ошибки....
Добрый день,
какие именно ошибки-то? На мэйл-ру и в аттаче один и тот же файл с текстом программы. А интересно узнать, на какой именно строке программы останавливается и каким сообщением ругается.
Цитата (rivale)
А теперь уже с первых строк выдает такие ошибки....
Добрый день,
какие именно ошибки-то? На мэйл-ру и в аттаче один и тот же файл с текстом программы. А интересно узнать, на какой именно строке программы останавливается и каким сообщением ругается.Gustav
А вот здесь http://www.mrexcel.com/forum....ng.html пишут, что этот объект был удалён чуть ли не случайно! Из-за отсутствия должного взаимодействия между командами разработчиков VBA и Excel
Версия Excel менялась на компьютере? Какая была, когда запускалось, и какая стала, когда перестало работать?
А вот здесь http://www.mrexcel.com/forum....ng.html пишут, что этот объект был удалён чуть ли не случайно! Из-за отсутствия должного взаимодействия между командами разработчиков VBA и Excel Gustav
rivale, Переходите к использованию объекта автоматизации «Scripting.FileSystemObject» пример как работает:
[vba]
Код
Dim fso, msg Set fso = CreateObject("Scripting.FileSystemObject") If (fso.FileExists("d:\Общие\Презентации\город.ppt" )) Then msg = "файл есть" Else msg = "файла нет" End If
[/vba]
rivale, Переходите к использованию объекта автоматизации «Scripting.FileSystemObject» пример как работает:
[vba]
Код
Dim fso, msg Set fso = CreateObject("Scripting.FileSystemObject") If (fso.FileExists("d:\Общие\Презентации\город.ppt" )) Then msg = "файл есть" Else msg = "файла нет" End If