Добрый день всем! И снова вопросы по VBA, прошу подсказать по следующее: ранее был написан макрос для рассылки писем, однако периодически возникает необходимость проведения подобной рассылки с двух различных адресов: один от имени сотрудника, а другой от имени департамента (некие информационные письма). В Outlook сотрудника подключены две почтовые учетные записи - его (mail1@mail.ru) и департамента (mail2@mail.ru), при этом первичной является учетка сотрудника - по умолчанию письма отправляются с его адреса (и она же привязана к его учетной записи на машине). Поискав в необъятноим интеренете наткнулся, что метод .Logon имеет четыре опциональных параметра: Profile, Password, ShowDialog, NewSession, попытался прикрутить это в макрос, получилась такая запись
Код
OutApp.Session.Logon mail2@mail.ru, "",True, True
но результат - ноль. Что я сделал не так? Ниже привожу часть макроса рассылки:
Код
Sub SendMail()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim lLastRow As Long
Dim i&
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application" )
OutApp.Session.Logon "mail2@mail.ru", "",True, True
On Error GoTo cleanup
On Error Resume Next
End Sub
А профиль именно так называется? Проверить не могу - не использую аутлук. У меня Мышь_летучая. Могу только высказывать свои умозаключения. ЗЫ Если не в тягость, внесите поправку в макрос в стартовом сообщении. ЗЫЗЫ Может где пароль "" поставить, если он пустой.
с Logon в аутлуке как-то все непросто сам однажды пытался сделать такую опцию в программе рассылки писем, - работает через раз, закономерности не понял в итоге, плюнул на это дело, и убрал строку с Logon - решив ограничиться только ящиком, настроенным по-умолчанию
Есть такой параметр - .SetOnBehalfOfName...Может его стоит попробовать?
Код
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "кому"
.From = "департамент"
.SetOnBehalfOfName = "mail2@mail.ru"
.Subject = "информационное письмо"
.Body = "какой-то текст"
.Send
End With
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
6 пишет: Есть такой параметр - .SetOnBehalfOfName...
Большое спасибо! Проблема решена, главное, что бы у пользователя были соответствующие права от администратора. Ну и еще использовал по глупости копипасту с Вашего сообщения, а там буква пропущена, позор мне) Параметр .SentOnBehalfOfName
Добрый вечер! весь код собрал, а пользователей не переключает, винда 10 , может кто поможет? Спасибо!
Код
Sub SendMail()
Dim OutApp As Object
Dim OutMail As Object
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "Mail1@mail.ru"
.From = "Mail22mail.ru"
.SetOnBehalfOfName = "mail1@mail.ru"
.Subject = "что то"
.Body = "что нибудь"
.Send
End With
End Sub
Dimarik1987, Задача очень косвенно касается Excel, и всеж. SetOnBehalfOfName используется в тех случаях, когда надо показать что отправляет кто-то за другого. Например помощник за руководителя. Эти права должны быть даны на сервере и обычный Mail.ru такое не предоставляет. Для отправки от другого аккаунта нужно именно переключится на него и ниже ответ на #13
Код
Sub SendMail()
Dim OutApp As Object
Dim OutMail As Object
'Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
For Each oAccount In OutApp.Session.Accounts
If oAccount = "mail2@mail.ru" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "mail11@mail.ru"
'.From = "Mail2@gmail.com"
'.SetOnBehalfOfName = "mail1@mail.ru"
.Subject = "test"
.Body = "test"
Set .SendUsingAccount = oAccount
.Send
End With
End If
Next
End Sub
БМВ, ругается, что oAccount "variable not defined" (((
Код
Dim objOL As Object
Dim objMail As Object
Set objOL = CreateObject("Outlook.Application")
objOL.Session.Logon
For Each oAccount In objOL.Session.Accounts
If oAccount = "ruslo@gmail.com" Then
Set objMail = objOL.CreateItem(0)
On Error Resume Next
With objMail
.From = "ruslo@gmail.com"
.To = "Cargo@cargo.mu"
.Body = "Пришлите, пожалуйста. Спасибо!"
.Subject = "Запрос"
For i = 1 To kf
.Attachments.Add nam(i)
Next i
Set .SendUsingAccount = oAccount
.Send
End With
End If
Next
Добрый день. Подскажите, пожалуйста. Если я делаю не новое письмо, а прогоняю процедуру пересылки (.Forward) найденного в почте мной письма, то не получается выбрать ящик с которого отправлять письмо Привожу часть кода
Код
Set maillist = objnamespace.Folders("xxxx@mail.ru").Folders("Имя папки, в которой будем искать письма").Items
Rectime = "сюда вытягиваю из ячейки Excel время письма"
e = Format(Rectime, "ddddd hh:mm")
e = Format(DateAdd("n", -1, e), "ddddd hh:mm")
e1 = Format(DateAdd("n", 2, e), "ddddd hh:mm")
strfilter = "[ReceivedTime]>'" & e & "' and [ReceivedTime]<'" & e1 & "'"
Set filtered_items = maillist.Restrict(strfilter)
fitems = filtered_items.Count
If fitems >0 Then
For i = 1 To Fitems
If filtered_items(i).ConversationID = "ссылка на ячейку Excel" And Rectime = Cstr(filtered_items(i).ReceivedTime) Then
Set olreply = filtered_items(i).Forward
With olreply
.SentOnBehalfOfName = "yyy@mail.ru"
.To = "yyy@mail.ru"
.Subject = "Тема письма"
.Send '.Display
End With
End If
Next
Else
MsgBox "Письмо не найдено в папке Обработанные"
Cancel = True
Exit Sub
End If
Т.к. поиск письма осуществляется на технологическом почтовом ящике (ТПЯ), то по умолчанию пересылка производится с него же С помощью SentOnBehalfOfName значение отправителя меняется (это видно с помощью .Display), но при отправке письма, фактически оно всё равно приходит от имени ТПЯ, а не "yyy@mail.ru"
В чем может быть проблема? может необходимо какой-то другой параметр менять? Подскажите, пожалуйста Т.е. фактически SentOnBehalfOfName работает, только если создается новое письмо, а не пересылается другое