0 / 0 / 0
Регистрация: 09.01.2015
Сообщений: 62
1

Пересылка входящих писем Outlook посредством VBA

03.03.2015, 07:50. Показов 11464. Ответов 16
Метки нет (Все метки)

Добрый день!
Подскажите,пожалуйста:
1.Необходимо чтобы всех входящие письма Outlook отправлялись на эл.почты сотрудников.Список эл.почт напечатан в экселе
2.Входящие письма должны перенаправлятся сотрудникам в порядке очереди.К примеру:сегодня работаю 3 сотрудника:Маша,Петя,Гриша.Первое письмо отправляется Маше,второе Пете,третье Грише,четвертое Маше...и так по кругу
помогите...плиз...уже все обыскала
__________________
Помощь в написании контрольных, курсовых и дипломных работ, диссертаций здесь
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
03.03.2015, 07:50
Ответы с готовыми решениями:

Пересылка писем Outlook от имени другого ящика
Добрый день! Ситуация такая. Есть Exchange сервер внутри организации, все пользователи домена к...

Сохранение входящих писем из Outlook
Прошу помощи у более опытных товарищей. Может кто то решал задачу сохранения писем из определенной...

Сохранение и перемещение входящих писем из Outlook
Добрий день! Прошу помочь в написании макроса на VBA для сохранения активного письма в Outlook()...

Регистрация входящих писем Outlook в Excel
Добрый день! Решил написать небольшой макрос по регистрации входящей почты outlook в книге excel....

16
496 / 130 / 19
Регистрация: 30.03.2010
Сообщений: 224
03.03.2015, 11:52 2
Лучший ответ Сообщение было отмечено Екатерина55 как решение

Решение

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Private Sub Application_Startup()
'событие запуска аутлука
Dim objApp As Object
On Error Resume Next
   Set objApp = GetObject(, "Excel.Application")
If Err Then
   On Error Resume Next
      Set objApp = CreateObject("Excel.Application")
   If Err Then
      MsgBox "Не удалось запустить Excel"
      Exit Sub
   End If
End If
 
Dim objBook As Object
Set objBook = objApp.WorkBooks.Open(BookName) 'здесь указать имя книги
'здесь вставить код, вычитывающий адресатов из книги
 
Set objApp = Nothing
Set objBook = Nothing
End Sub
 
Private Sub Application_NewMail()
'событие получения нового письма
Dim objMails As Object
Dim objMail As Object
Set objMails = Application.Session.GetDefaultFolder(olFolderInbox).Items
Set objMail = objMail(objMails.Count)
objMail.Forward
objMail.Recipients.Add "<сюда вписать адресата>"
objMail.Send
Set objMails = Nothing
Set objMail = Nothing
End Sub
код нужно вставить в модуль приложения (ThisOutlookSession)
2
0 / 0 / 0
Регистрация: 09.01.2015
Сообщений: 62
03.03.2015, 13:42  [ТС] 3
как я понела,строчка 30 objMail.Recipients.Add "<сюда вписать адресата>"
необходимо вписывать вручную адреса эл.почт,а как вместо этой строчки вписать ссылку на файл экселя,откуда он будит брать адреса эл.почт,и отправлять

Наверно так:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Private Sub Application_NewMail()
'событие получения нового письма
Dim objMails As Object
Dim objMail As Object
Dim objBook As Object 
Set objApp = Nothing
Set objBook = Nothing
Set objMails = Application.Session.GetDefaultFolder(olFolderInbox).Items
Set objMail = objMail(objMails.Count)
objMail.Forward
Set objBook = objApp.WorkBooks.Open(BookName) 'здесь указать имя книги
'здесь вставить код, вычитывающий адресатов из книги
objMail.Send
Set objMails = Nothing
Set objMail = Nothing
End Sub
0
496 / 130 / 19
Регистрация: 30.03.2010
Сообщений: 224
03.03.2015, 17:12 4
Лучший ответ Сообщение было отмечено Екатерина55 как решение

Решение

есть два обработчика событий: Application_NewMail - получение нового письма и Application_Startup - запуск аутлука
книга вычитывается только при запуске аутлука (зачем дергать Excel каждый раз), адреса сотрудников сохраняются в публичном массиве, из которого потом подставляются в objMail.Recipients.Add "<сюда вписать адресата>"
1
0 / 0 / 0
Регистрация: 09.01.2015
Сообщений: 62
03.03.2015, 20:53  [ТС] 5
Set objBook = objApp.WorkBooks.Open(BookName) 'здесь указать имя книги
'здесь вставить код, вычитывающий адресатов из книги

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

к примеру вставить путь ?:C:\Users\HP\Desktop\Книга1.xlsx
0
496 / 130 / 19
Регистрация: 30.03.2010
Сообщений: 224
04.03.2015, 11:21 6
указать имя книги примерно так:
Set objBook = objApp.WorkBooks.Open("C:\Users\HP\Desktop\Книга1. xlsx")

код, вычитывающий адресатов из книги, будет выглядеть ПРИМЕРНО так:
Visual Basic
1
2
3
4
5
6
7
Dim countStaff As Long
countStaff =  'здесь определеить и присвоить количество адресатов
ReDim arrayName(countStaff) As String
Dim I As Long
For I = 1 To countStaff
    arrayName(countStaff) = objBook.Sheets("Лист1").Cells(countStaff, 1)
Next
массив arrayName должен быть объявлен на уровне модуля, чтобы обработчик получения почты также мог его видеть
1
0 / 0 / 0
Регистрация: 09.01.2015
Сообщений: 62
04.03.2015, 11:50  [ТС] 7
стесняюсь спросить,полностью готовый программный модуль во вкладке ThisOurlookSession(в самой верхней) будет выглядеть так?
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Private Sub Application_Startup()
Dim objApp As Object
On Error Resume Next
Set objApp = GetObject(, "Excel.Application")
If Err Then
On Error Resume Next
Set objApp = CreateObject("Excel.Application")
If Err Then
MsgBox "Не найден Excel"
Exit Sub
End If
End If
 
Dim objBook As Object
Set objBook = objApp.WorkBooks.Open("C:\Users\HP\Desktop\Êíèãà1.xlsx")
Dim countStaff As Long
countStaff =  'çäåñü îïðåäåëåèòü è ïðèñâîèòü êîëè÷åñòâî àäðåñàòîâ'
ReDim arrayName(countStaff) As String
Dim I As Long
For I = 1 To countStaff
    arrayName(countStaff) = objBook.Sheets("Ëèñò1").Cells(countStaff, 1)
Next
Set objApp = Nothing
Set objBook = Nothing
End Sub
 
Private Sub Application_NewMail()
Dim objMails As Object
Dim objMail As Object
Set objMails = Application.Session.GetDefaultFolder(olFolderInbox).Items
Set objMail = objMails(objMails.Count)
objMail.Forward
objMail.Recipients.Add "<katerina.popkova@list.ru,elenaram@mail.ru>"
objMail.Send
Set objMails = Nothing
Set objMail = Nothing
End Sub
строчка countStaff = " здесь определеить и присвоить количество адресатов'' в качестве адресатов указать все эл.почты?
0
496 / 130 / 19
Регистрация: 30.03.2010
Сообщений: 224
04.03.2015, 11:59 8
Лучший ответ Сообщение было отмечено Екатерина55 как решение

Решение

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
Option Explicit
Dim arrayName() As String
Dim currentStaff As Long
 
Private Sub Application_Startup()
'событие запуска аутлука
Dim objApp As Object
On Error Resume Next
   Set objApp = GetObject(, "Excel.Application")
If Err Then
   On Error Resume Next
      Set objApp = CreateObject("Excel.Application")
   If Err Then
      MsgBox "Не удалось запустить Excel"
      Exit Sub
   End If
End If
 
Dim objBook As Object
Set objBook = objApp.Workbooks.Open("C:\Users\HP\Desktop\Книга1.xlsx")
 
Dim countStaff As Long
With objBook.Sheets("Лист1")
countStaff = .UsedRange.Row
ReDim arrayName(countStaff) As String
 
Dim I As Long
For I = 1 To countStaff
    arrayName(countStaff) = .Cells(countStaff, 1) 'вместо 1 - номер столбца с адресами
Next
End With
 
Set objApp = Nothing
Set objBook = Nothing
 
currentStaff = 1
End Sub
 
Private Sub Application_NewMail()
'событие получения нового письма
Dim objMails As Object
Dim objMail As Object
Set objMails = Application.Session.GetDefaultFolder(olFolderInbox).Items
Set objMail = objMails(objMails.Count)
objMail.Forward
objMail.Recipients.Add arrayName(currentStaff)
objMail.Send
Set objMails = Nothing
Set objMail = Nothing
 
If currentStaff < UBound(arrayName) Then
   currentStaff = currentStaff + 1
Else
   currentStaff = 1
End If
End Sub
этот код надо вставить в ThisOutlookSessions!!!!!!!!!!!!!!!!!!!!
что он делает:
при загрузке аутлука открывает книгу C:\Users\HP\Desktop\Книга1.xlsx
с Лист1 из 1-ого столбца (если не первый, заменить единицу на нужное значение) вычитывает и сохраняет ВСЕ адреса; закрывает книгу
при получении в аутлуке нового письма пересылает его адресату
сначала первому, потом второму и т.д. по кругу

Вот что стоило, сформулировать точно задачу и выложить пример книги?!!
Изображения
 
1
0 / 0 / 0
Регистрация: 09.01.2015
Сообщений: 62
04.03.2015, 15:32  [ТС] 9
Cпасибо!наконецто дошлотысячи благодарностей
0
0 / 0 / 0
Регистрация: 09.01.2015
Сообщений: 62
04.03.2015, 16:21  [ТС] 10
еще один глупый вопрос,пробовала протестировать почту,выходит ошибка:Нарушены границы массива и выделяю строчку Set objMail = objMails(objMails.Count)(скрины прилагю).Пробола изменить на Set objMail = objMails(objMails.Count-1)
Миниатюры
Пересылка входящих писем Outlook посредством VBA   Пересылка входящих писем Outlook посредством VBA  
0
496 / 130 / 19
Регистрация: 30.03.2010
Сообщений: 224
04.03.2015, 17:25 11
-1 добавлять не надо - в бейсике массивы начинаются с единицы
Set objMails = Application.Session.GetDefaultFolder(olFolderInbox ).Items - в этой строке объект objMails получает все элементы (письма) из папки входящие, количество этих писем в свойстве objMails.Count
Set objMail = objMails(objMails.Count) - в этой строке объект objMail получает objMails.Count-й (то есть, последний) элемент множества objMails (то есть всех входящих писем)
формально все правильно, тут помочь уже нечем
в чем проблема можно узнать только под отладчиком, скалывайте в окно Watch объекты objMail и objMails и ищите в чем дело
1
0 / 0 / 0
Регистрация: 09.01.2015
Сообщений: 62
04.03.2015, 18:35  [ТС] 12
Теперь при выполнении RUN-Run Macro (запуске программы) выходит создание наименование макроса (скрины) а зачем новый макрос создавать..и что туда вписывать
Миниатюры
Пересылка входящих писем Outlook посредством VBA  
0
0 / 0 / 0
Регистрация: 09.01.2015
Сообщений: 62
04.03.2015, 23:24  [ТС] 13
в окошке локальных данных обнаружила что коллекция пуста
Миниатюры
Пересылка входящих писем Outlook посредством VBA  
0
496 / 130 / 19
Регистрация: 30.03.2010
Сообщений: 224
05.03.2015, 15:30 14
Цитата Сообщение от Екатерина55 Посмотреть сообщение
Теперь при выполнении RUN-Run Macro (запуске программы) выходит создание наименование макроса (скрины) а зачем новый макрос создавать..и что туда вписывать
ничего создавать не надо и запускать по Run - тоже не надо - функции Application_Startup и Application_NewMail не являются мкросами в обычном понимании этого слова, они - функции-обработчики событий и запускаются сами при возникновении соотвествующего события, Application_Startup автоматически выполняется при запуске атлука, а Application_NewMail - по приходу нового письма

Добавлено через 5 минут
Цитата Сообщение от Екатерина55 Посмотреть сообщение
в окошке локальных данных обнаружила что коллекция пуста
это коллекция соответствует папке Входящие и Count = 0 означает, что во входящих писем нет вообще
такое может быть?
0
0 / 0 / 0
Регистрация: 09.01.2015
Сообщений: 62
05.03.2015, 15:57  [ТС] 15
Пробола снова отправить новое сообщение,меня сразу перекинули на VBA c той же ошибкой,хотя Count теперь =10
1.Я пробола удалить экселевский файл с рабочего стола (где ему путь прописан),ошибку "не найден Exell "он не выдал,почему
2.Мне кажется что список адресов не взят в массив.
Что бы его взять в массив надо изменить часть кода:
Visual Basic
1
2
3
4
5
6
7
With objBook.Sheets("Лист1")
countStaff = .UsedRange.Rows.Count
ReDim arrayName(countStaff) As String
For I = 1 To countStaff
    arrayName(I) = .Cells(I, 1) 'вместо 1 - номер столбца с адресами
Next
End With
Миниатюры
Пересылка входящих писем Outlook посредством VBA  
0
0 / 0 / 0
Регистрация: 11.11.2019
Сообщений: 1
12.11.2019, 10:48 16
petr-sev, добрый день. попробовал применить данный код, не работает. Я ни разу не программист, можете подсказать?
0
496 / 130 / 19
Регистрация: 30.03.2010
Сообщений: 224
12.11.2019, 22:18 17
добрый
если после фразы "доктор, у меня болит" вам поставят диагноз и выпишут лечение, дайте мне адресок этого чудотворца )))
к сожалению, у меня с чудесами плохо и нужны хоть какие-то симптомы
что делаете - что получается - что вообще хотелось получить
плюс этой теме уже почти пять лет и вряд ли кто из участников обсуждения помнит о чем тут вообще шла речь
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
12.11.2019, 22:18
Помогаю со студенческими работами здесь

Макрос для Outlook: автоматическая проверка всех входящих писем
Друзья, простите что обращаюсь, но уже давно пытаюсь и никак не могу написать макрос для outlook....

Макрос для Outlook: автоматическая проверка входящих писем и сохранение аттачментов
Доброго времени суток,друзья! Я не являюсь специалистом в области макросов, но возникла...

Отправка писем из MS Outlook макросом VBA
Подскажите пожалуйста, можно ли при отправке писем макросом изменить шрифт и цвет текста....

Код на VBA для Outlook (поиск непрочитанных писем)
Подскажите, пожалуйста, какой код понадобится для следующих действий: Необходимо с заданной...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
17
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2023, CyberForum.ru