Извлечь адресатов активного письма

Дата: Вторник, 21.12.2021, 11:37 | Сообщение № 1

Группа: Админы

Ранг: Местный житель

Сообщений: 16475

Репутация: 2749 ±

Замечаний: ±

Excel 2016

Привет всем, друзья!

Может кто знает, как извлечь адресатов активного письма Outlook для присвоения их переменным в коде VBA?

Суть: Отправляю кодом письма в ответ на определенные. Делаю так - получил письмо, посмотрел вложение Excel, нажал кнопку - отправились письма нужным адресатам с соответствующими листами из Excel-вложения. Это уже есть и хорошо работает. Однако, при автоматической отправке писем, необходимо ещё в копию ставить тех, на чьё письмо отвечаю, т.е. как-то надо извлечь в VBA адресатов полученного исходного письма

Кто знает?

[p.s.]Рабочий макрос - в Excel

ЮMoney:41001419691823 | WMR:126292472390

bmv98rus

Дата: Вторник, 21.12.2021, 20:58 | Сообщение № 2

Группа: Друзья

Ранг: Участник клуба

Сообщений: 4120

Репутация: 769 ±

Замечаний: 0% ±

Excel 2013/2016

бррр, ну если есть связь с объектом сообщения на которое ответ идет то там есть все адресаты. Сергей, реально не понятна проблема.

~~Замечательный~~ Временно просто медведь ~~, процентов на 20~~.

Дата: Среда, 22.12.2021, 09:17 | Сообщение № 3

Группа: Админы

Ранг: Местный житель

Сообщений: 16475

Репутация: 2749 ±

Замечаний: ±

Excel 2016

1. Я получаю письмо от Коллега1, в копии - Коллега2 (в копии может быть разное число Коллег)
2. Открываю вложение из этого письма (Excel-файл)
3. Запускаю макрос (он в Personal)
4. Часть Excel-вложения из этого письма отправляется вложением в новое письмо Коллега3 макросом (e-mail Коллега3 прописан в коде)
5. В новом письме, адресованном Коллега3, в копию надо поставить того, от кого я получил исходное письмо - Коллега1, и кто был в его копии - Коллега2
Как это сделать (п.5)?

ЮMoney:41001419691823 | WMR:126292472390

Дата: Среда, 22.12.2021, 13:52 | Сообщение № 4

Группа: Проверенные

Ранг: Обитатель

Сообщений: 415

Репутация: 129 ±

Замечаний: 0% ±

Excel 2007

Может ТУТ что-нибудь есть

Дата: Среда, 22.12.2021, 14:16 | Сообщение № 5

Группа: Админы

Ранг: Местный житель

Сообщений: 16475

Репутация: 2749 ±

Замечаний: ±

Excel 2016

msi2102, спасибо, но по ссылке обучалка "как отправить письмо", а это у меня

Цитата Serge_007, 21.12.2021 в 11:37, в сообщении № 1 (

)

уже есть и хорошо работает

ЮMoney:41001419691823 | WMR:126292472390

Дата: Среда, 22.12.2021, 14:35 | Сообщение № 6

Группа: Проверенные

Ранг: Обитатель

Сообщений: 415

Репутация: 129 ±

Замечаний: 0% ±

Excel 2007

Макрос
[vba]

Код

Sub AVPO()
Set myOlApp = CreateObject("Outlook.Application")
Set myNamespace = myOlApp.GetNamespace("MAPI")
Set myRecipient = myNamespace.CreateRecipient("ПОЧТА@terminal.ru")
myRecipient.Resolve
Set avpofolder = myNamespace.GetSharedDefaultFolder(myRecipient, olFolderInbox)
Dim msg As Outlook.MailItem
  If avpofolder.Items.Count > 0 Then
    For Each msg In avpofolder.Items
    Debug.Print "Кому: " & msg.To & " \ Копия: " & msg.CC
        'Сюда можно вписать действия над почтовыми сообщениями
    Next
  End If
End Sub

[/vba]

Сообщение отредактировал msi2102 - Среда, 22.12.2021, 14:49

Дата: Среда, 22.12.2021, 14:47 | Сообщение № 7

Группа: Админы

Ранг: Местный житель

Сообщений: 16475

Репутация: 2749 ±

Замечаний: ±

Excel 2016

Ссылки на кибер у нас не приветствуются...

К сообщению приложен файл: 8775603.png (27.1 Kb)

ЮMoney:41001419691823 | WMR:126292472390

Дата: Среда, 22.12.2021, 14:50 | Сообщение № 8

Группа: Проверенные

Ранг: Обитатель

Сообщений: 415

Репутация: 129 ±

Замечаний: 0% ±

Excel 2007

[vba]

Код

Set myRecipient = myNamespace.CreateRecipient("ПОЧТА@terminal.ru")

[/vba]
Нужно заменить на свою почту

Дата: Среда, 22.12.2021, 14:54 | Сообщение № 9

Группа: Админы

Ранг: Местный житель

Сообщений: 16475

Репутация: 2749 ±

Замечаний: ±

Excel 2016

Я заменил
Выкладывать рабочую почту сюда нельзя, поэтому сделал монтаж
Ошибка одинаковая, при любой почте в CreateRecipient

ЮMoney:41001419691823 | WMR:126292472390

Дата: Среда, 22.12.2021, 14:56 | Сообщение № 10

Группа: Проверенные

Ранг: Обитатель

Сообщений: 415

Репутация: 129 ±

Замечаний: 0% ±

Excel 2007

А библиотека объектов Microsoft Outlook подключена?
У меня работает без ошибки

Дата: Среда, 22.12.2021, 15:05 | Сообщение № 11

Группа: Админы

Ранг: Местный житель

Сообщений: 16475

Репутация: 2749 ±

Замечаний: ±

Excel 2016

Цитата msi2102, 22.12.2021 в 14:56, в сообщении № 10 (

)

иблиотека объектов Microsoft Outlook подключена?

В ней дело было подключил, заработал макрос, спасибо)

Но
Возвращает имя (не e-mail) одного сотрудника
Откуда? В активном письме этого сотрудника нет

ЮMoney:41001419691823 | WMR:126292472390

Дата: Среда, 22.12.2021, 15:45 | Сообщение № 12

Группа: Проверенные

Ранг: Обитатель

Сообщений: 415

Репутация: 129 ±

Замечаний: 0% ±

Excel 2007

msg.SendUsingAccount - это адрес отправителя
msg.To - имя Получателя
msg.CC - имя Получателей в копии
К сожалению как получить адреса вместо имен из копии не знаю.
[vba]

Код

Sub AVPO()
Set myOlApp = CreateObject("Outlook.Application")
Set myNamespace = myOlApp.GetNamespace("MAPI")
Set myRecipient = myNamespace.CreateRecipient("ПОЧТА@terminal.ru")
myRecipient.Resolve
Set avpofolder = myNamespace.GetSharedDefaultFolder(myRecipient, olFolderInbox)
Dim msg As Outlook.MailItem
  If avpofolder.Items.Count > 0 Then
    For Each msg In avpofolder.Items
    Debug.Print "Кому: " & msg.To & " \ Копия: " & msg.CC & " \ Адрес отправителя: " & msg.SendUsingAccount & " \ Имя отправителя: " & msg.SenderName '
        'Сюда можно вписать действия над почтовыми сообщениями
    Next
  End If
End Sub

[/vba]

Сообщение отредактировал msi2102 - Среда, 22.12.2021, 15:52

Дата: Среда, 22.12.2021, 15:59 | Сообщение № 13

Группа: Админы

Ранг: Местный житель

Сообщений: 16475

Репутация: 2749 ±

Замечаний: ±

Excel 2016

Макрос проходит циклом по папке "Входящие" и извлекает из них имена отправителей и находящихся в копии
Это хорошо, но у меня вопрос-то в другом...

Мне нужно

Цитата Serge_007, 21.12.2021 в 11:37, в сообщении № 1 (

)

извлечь адресатов активного письма Outlook

, т.е письма, выделенного курсором в папке "Входящие", либо открытого в отдельном окне (двойным кликом)

[p.s.]

Цитата msi2102, 22.12.2021 в 15:45, в сообщении № 12 (

)

msg.SendUsingAccount - это адрес отправителя

У меня выводит мой адрес, а не отправителя([/p.s.]

ЮMoney:41001419691823 | WMR:126292472390

Дата: Среда, 22.12.2021, 16:09 | Сообщение № 14

Группа: Проверенные

Ранг: Обитатель

Сообщений: 415

Репутация: 129 ±

Замечаний: 0% ±

Excel 2007

Цитата Serge_007, 22.12.2021 в 15:59, в сообщении № 13 (

)

У меня выводит мой адрес, а не отправителя(

мой косяк и msg.SenderName тоже Ваше имя.
.CC это поле КОПИЯ, а там пишутся только имена
К сожалению на это мои познания закончились, чем могу

Дата: Среда, 22.12.2021, 16:15 | Сообщение № 15

Группа: Админы

Ранг: Местный житель

Сообщений: 16475

Репутация: 2749 ±

Замечаний: ±

Excel 2016

Цитата msi2102, 22.12.2021 в 16:09, в сообщении № 14 (

)

чем могу

Сергей, спасибо!

Я в Outlook не ноль даже, а минус, поэтому Ваш макрос всё-равно был для меня полезен (новые знания)

Осталось всё же решить исходную проблему

ЮMoney:41001419691823 | WMR:126292472390

krosav4ig

Дата: Среда, 22.12.2021, 20:46 | Сообщение № 16

Группа: Друзья

Ранг: Старожил

Сообщений: 2347

Репутация: 997 ±

Замечаний: 0% ±

Excel 2007,2010,2013

Добрый вечер.
Если письмо открыто в отдельном окне,
[vba]

Код

    With GetObject(, "Outlook.Application")
        'текущее письмо, открытое в отдельном окне
        Set oMailItm = .ActiveInspector.CurrentItem
        'ответное письмо, созданное действием Ответить всем
        Set oReply = oMailItm.Actions("Ответить всем").Execute
        'отобразить ответное письмо
        oReply.display: AppActivate oReply.GetInspector.Caption
    End With

[/vba]

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Дата: Четверг, 23.12.2021, 08:05 | Сообщение № 17

Группа: Проверенные

Ранг: Обитатель

Сообщений: 415

Репутация: 129 ±

Замечаний: 0% ±

Excel 2007

Цитата Serge_007, 22.12.2021 в 09:17, в сообщении № 3 (

)

В новом письме, адресованном Коллега3, в копию надо поставить того, от кого я получил исходное письмо - Коллега1, и кто был в его копии - Коллега2

Ну тогда с кодом Красавчика совсем просто, только при условии

Цитата krosav4ig, 22.12.2021 в 20:46, в сообщении № 16 (

)

Если письмо открыто в отдельном окне

[vba]

Код

Sub Ответить_всем()
'письмо должно быть открыто в отдельном окне
    With GetObject(, "Outlook.Application")
        'текущее письмо, открытое в отдельном окне
        Set oMailItm = .ActiveInspector.CurrentItem
        'ответное письмо, созданное действием Ответить всем
        Set oReply = oMailItm.Actions("Ответить всем").Execute
        'отобразить ответное письмо
        With oReply
            .Display
            AppActivate .GetInspector.Caption
            .CC = .CC & "; " & .To
            .To = "Коллега3 Иван Иванович"
            .HTMLBody = "ПРОБА на письмо не отвечать" & Chr(13) & .HTMLBody
            .Send
            Debug.Print "Кому: " & .To & " \ Копия: " & .CC
        End With
    End With
End Sub

[/vba]
В начале Вас не понял, думал нужны Адреса, а оказывается нужны Адресаты

Сообщение отредактировал msi2102 - Четверг, 23.12.2021, 08:06