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

Дата: Четверг, 23.12.2021, 13:26 | Сообщение № 21

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

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

Сообщений: 2347

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

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

Excel 2007,2010,2013

[vba]

Код

    Const PR_SMTP_ADDRESS$ = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
    With GetObject(, "Outlook.Application")
        Set oMailItm = .ActiveInspector.CurrentItem
        With .CreateItem(0)
            myAddr = oMailItm.Session.CurrentUser.PropertyAccessor.GetProperty(PR_SMTP_ADDRESS)
            For Each r In oMailItm.Recipients
                sAddr = r.PropertyAccessor.GetProperty(PR_SMTP_ADDRESS)
                If myAddr <> sAddr Then s = s & """" & r.Name & """<" & sAddr & ">;"
            Next
            .To = "Коллега<name@domain.zone>;"
            .CC = s
            .Recipients.ResolveAll
            .Display
            AppActivate .GetInspector.Caption
        End With
    End With

[/vba]

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

Сообщение отредактировал krosav4ig - Четверг, 23.12.2021, 21:54

RAN

Дата: Четверг, 23.12.2021, 14:21 | Сообщение № 22

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

Ранг: Экселист

Сообщений: 5660

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

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

2010

Андрей, точно?
[vba]

Код

With Application.CreateItem(olMailItem)

[/vba]
Или все же
[vba]

Код

With .CreateItem(olMailItem)

[/vba]

Быть или не быть, вот в чем загвоздка!

Дата: Четверг, 23.12.2021, 14:37 | Сообщение № 23

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

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

Сообщений: 4120

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

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

Excel 2013/2016

Цитата krosav4ig, 23.12.2021 в 13:26, в сообщении № 21 (

)

With r.AddressEntry

Андрей почему просто не просто .address?

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

Serge_007

Дата: Четверг, 23.12.2021, 14:43 | Сообщение № 24

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

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

Сообщений: 16475

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

Замечаний: ±

Excel 2016

Цитата RAN, 23.12.2021 в 14:21, в сообщении № 22 (

)

Или все же

Да, так работает

Ребят, мне нужен просто вывод адресатов, не надо что бы письмо создавалось и адресаты туда впихивались, это всё будет происходить в другом коде...

ЮMoney:41001419691823 | WMR:126292472390

Дата: Четверг, 23.12.2021, 14:54 | Сообщение № 25

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

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

Сообщений: 2347

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

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

Excel 2007,2010,2013

Цитата RAN, 23.12.2021 в 14:21, в сообщении № 22 (

)

Андрей, точно?

не точно, исправил

Цитата bmv98rus, 23.12.2021 в 14:37, в сообщении № 23 (

)

почему просто не просто .address?

на всяк случай, вдруг Exchange

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

Дата: Четверг, 23.12.2021, 18:11 | Сообщение № 26

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

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

Сообщений: 4120

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

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

Excel 2013/2016

Цитата krosav4ig, 23.12.2021 в 14:54, в сообщении № 25 (

)

вдруг Exchange

так там одно и тоже будет.

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

Дата: Четверг, 23.12.2021, 19:01 | Сообщение № 27

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

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

Сообщений: 2347

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

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

Excel 2007,2010,2013

Цитата bmv98rus, 23.12.2021 в 18:11, в сообщении № 26 (

)

так там одно и тоже будет

я бы не был так уверен https://docs.microsoft.com/en-us....il-item

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

Дата: Четверг, 23.12.2021, 19:41 | Сообщение № 28

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

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

Сообщений: 4120

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

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

Excel 2013/2016

я проверял, да тип однозначно определяет формат, но
[vba]

Код

? oMailItm.recipients(2).address
d.a...a@g...l.ru
?oMailItm.recipients(2).AddressEntry
d.a...a@g...l.ru
?oMailItm.recipients(1).address
/o=G....l/ou=Exchange Administrative Group (FYDIBOHF23SPDLT)/cn=Recipients/cn=B... M...c82
?oMailItm.recipients(1).AddressEntry.address
/o=G....l/ou=Exchange Administrative Group (FYDIBOHF23SPDLT)/cn=Recipients/cn=B... M...c82

[/vba]

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

Дата: Четверг, 23.12.2021, 21:09 | Сообщение № 29

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

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

Сообщений: 2347

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

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

Excel 2007,2010,2013

Да, .Address в обоих случаях одинаковы, но я забираю PrimarySMTPAddress
а AddressEntry тут действительно не нужен, изначально думал делать проверку на тип адреса и пользовать .GetExchangeUser.PrimarySmtpAddress если тип = "EX"
Обновил код в посте

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

Сообщение отредактировал krosav4ig - Четверг, 23.12.2021, 22:04

Дата: Четверг, 23.12.2021, 23:03 | Сообщение № 30

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

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

Сообщений: 4120

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

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

Excel 2013/2016

krosav4ig, нет смысла выбирать SNTP если EX то брать можно .name . если SMTP, то .address. далее клиент сам разберется.
[vba]

Код

With GetObject(, "Outlook.Application")
        Set oMailItm = .ActiveInspector.CurrentItem
        With .CreateItem(0)
            myAddr = oMailItm.Session.CurrentUser.Address
            For Each R In oMailItm.Recipients

                If myAddr <> R.Address Then _
                    s = s & """" & R.Name & IIf(R.Type = "EX", "", """<" & R.Address & ">") & ";"
            Next

[/vba]

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

Сообщение отредактировал bmv98rus - Четверг, 23.12.2021, 23:15

Serge_007

Дата: Пятница, 24.12.2021, 09:36 | Сообщение № 31

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

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

Сообщений: 16475

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

Замечаний: ±

Excel 2016

Цитата Serge_007, 23.12.2021 в 14:43, в сообщении № 24 (

)

нужен просто вывод адресатов

Кто нибудь знает как это сделать?

ЮMoney:41001419691823 | WMR:126292472390

Дата: Пятница, 24.12.2021, 09:41 | Сообщение № 32

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

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

Сообщений: 4120

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

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

Excel 2013/2016

Цитата Serge_007, 24.12.2021 в 09:36, в сообщении № 31 (

)

Кто нибудь знает как это сделать?

Сергей, так что Андрей, что я (назве что я не стал дописывать концовку) привели код. в s список через разделитель, за исключением адреса того, кто отправляет, но был в адресатах.

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

Serge_007

Дата: Пятница, 24.12.2021, 09:49 | Сообщение № 33

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

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

Сообщений: 16475

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

Замечаний: ±

Excel 2016

Андрей написал код, который создает новое письмо и заполняет список адресатов - это не надо, в твоем коде в s выводится только один адресат

Цитата bmv98rus, 24.12.2021 в 09:41, в сообщении № 32 (

)

за исключением адреса того, кто отправляет

- отправитель тоже нужен...

ЮMoney:41001419691823 | WMR:126292472390

Дата: Пятница, 24.12.2021, 10:21 | Сообщение № 34

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

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

Сообщений: 4120

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

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

Excel 2013/2016

Я чуть упростил код Андрея, оба удаляют из списка кому было направлено сообщение того, кто готовит новое. Ну если тебе пришло и ты отправляешь новое то самому себе не нужно отправлять наверно. собственно попробуй убрать If myAddr <> R.Address Then _ и в s список полный. Но туда надо добавлять тех кто был в копии аналогично этому циклу и того кто отправитель исходного. Я об этом выше писал.

[vba]

Код

With GetObject(, "Outlook.Application")
            Set oMailItm = .ActiveInspector.CurrentItem
            myAddr = oMailItm.Session.CurrentUser.Address
            s = s & """" & oMailItm.Sender.Name & IIf(oMailItm.Sender.Type = "EX", "", _
                  """<" & oMailItm.Sender.Address & ">") & ";"
            For Each R In oMailItm.Recipients
                If myAddr <> R.Address Then _
                    s = s & """" & R.Name & IIf(R.Type = "EX", "", """<" & R.Address & ">") & ";"
            Next
            If oMailItm.CC <> "" Then
                    s = s & oMailItm.CC & ";"
            End If
End With

[/vba]

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

)

активного письма Outlook

активного или выделенного? если второе то
.ActiveInspector.CurrentItem заменить на .ActiveExplorer.Selection.Item(1)

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

Сообщение отредактировал bmv98rus - Пятница, 24.12.2021, 18:15