powered by simpleCommunicator - 2.0.36     © 2025 Programmizd 02
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Отправка письма через определенную учетку
4 сообщений из 4, страница 1 из 1
Отправка письма через определенную учетку
    #36814441
Rfdshir
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Здравствуйте.
Проблема следующая: у пользователей в аутлуке по 2 учетки: Exchange - для почты внутри предприятия, и внешняя. Надстройка для аутлука должна отсылать письмо именно через Exchange,
вне зависимости от того, какая учетка используется по умолчанию.

Пытался решить двумя способами:

1) Использование sendusingaccount и отправка с помощью redemption.safemailitem.
Письмо помещается в "черновики", с пометкой "письмо будет отправлено с учетной записи user@pmp.local" (все правильно, это учетка Exchange), но после нажатия "отправить и получить" - отправляется с учетки по умолчанию.
Соответственно, если по умолчанию стоит внешняя учетка - письмо никуда не доходит.

Код: plaintext
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.
Public Sub sbSendEmail()
        
        Dim olApp As Outlook.Application
        Dim objMsg As Outlook.MailItem
        Dim objSafeMsg As Redemption.SafeMailItem
        Dim acc As Outlook.Account
        Dim j As Long
        Dim fa As Boolean = False

        olApp = CreateObject("Outlook.Application")

        'ищем учетку
        If olApp.Session.Accounts.Count >  0  Then
            For j =  1  To olApp.Session.Accounts.Count
                If olApp.Session.Accounts.Item(j).AccountType = Outlook.OlAccountType.olExchange Then
                    'нашли учетку Exchange
                    acc = olApp.Session.Accounts(j)
                    fa = True
                    Exit For
                End If
            Next j
        Else
            MsgBox("нет учеток")
        End If

        If (fa) Then
'если учетка Exchange существует - отправляем письмо
objMsg = olApp.CreateItem(Outlook.OlItemType.olMailItem)
            objMsg.Subject = "primer"
            objMsg.Body = "primer body"
            'objSafeMsg = CreateObject("Redemption.SafeMailItem")
            ''objSafeMsg.sendUsingAccount = acc
            'objSafeMsg.Item = objMsg
            'objSafeMsg.Recipients.Add("printrequest@pmp.local")
            'objSafeMsg.Recipients.ResolveAll()
            'objSafeMsg.Send()
            'objMsg = Nothing
            'objSafeMsg = Nothing
            'olApp = Nothing
else 
msgbox ("Не найдена учетная запись Exchange")
end if
end sub

2) Отправка письма через cdo с прямым указанием адреса отправителя. Но в этом случае для аутентификации на сервере требуется логин и пароль, без них - не работает. Логин и пароль используются от доменной учетки пользователя винды. Как я понимаю, вытащить пароль с помощью VB - нереально...

Код: plaintext
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.
public sub sendemail()

Dim oMSG As Object
            Dim oConfig As Object
            Dim CFields As Object
            Dim strBody As String

            oMSG = CreateObject("CDO.Message")
            oConfig = CreateObject("CDO.Configuration")
            CFields = oConfig.Fields
            oMSG.Configuration = oConfig

            CFields("http://schemas.microsoft.com/cdo/configuration/sendusing") =  2 
            CFields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.pmp.local"
            CFields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") =  1 
            CFields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") =  25 
            CFields("http://schemas.microsoft.com/cdo/configuration/sendusername") = "userlogin" 
            CFields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "userpassword" 
            CFields.Update()

            oMSG.To = "printrequest@pmp.local"
            oMSG.From = "userlogin@pmp.local"
            oMSG.Subject = "primer"
            oMSG.BodyPart.Charset = "windows-1251"
            oMSG.TextBody = "primer body"
            oMSG.Send()

end sub

В коде обильно успользуются примеры с форума sql.ru, за что большое-пребольшое спасибо!

Конечно, можно определить, каков тип учетки по умолчанию, и если не Exchange - уведомить пользователя, чтоб сам переключил.
Но, может, кто-нибудь сможет подсказать нормальный вариант решения?
...
Рейтинг: 0 / 0
Отправка письма через определенную учетку
    #36814442
Rfdshir
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Извините, в первом примере кода комменты случайно не убрал.

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
 
objSafeMsg = CreateObject("Redemption.SafeMailItem")
            objSafeMsg.sendUsingAccount = acc
            objSafeMsg.Item = objMsg
            objSafeMsg.Recipients.Add("printrequest@pmp.local")
            objSafeMsg.Recipients.ResolveAll()
            objSafeMsg.Send()
            objMsg = Nothing
            objSafeMsg = Nothing
            olApp = Nothing
...
Рейтинг: 0 / 0
Отправка письма через определенную учетку
    #36818273
Rfdshir
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
В общем, так и не найдя ответа, сделал следующее: завел отдельную учетку на серваке, пусть все письма(заявки) уходят через нее, с помощью CDO. Плюс перед Redemption очевиден - письма уходят сразу, не тусуясь в "черновиках", пока пользователь не нажмет "отправить и получить", да и redemption ставить юзерам не придется.

Правда, при таком раскладе в текст письма приходится добавлять адрес отправителя, и при ответе (программным же способом) - выдирать его обратно...
...
Рейтинг: 0 / 0
Период между сообщениями больше года.
Отправка письма через определенную учетку
    #39788589
controlgate
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Код: vbnet
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.
Sub Mail_()
'Only working in Office 2007-2016
'Don't forget to set a reference to Outlook in the VBA editor
    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim strbody As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)

    strbody = "Hi there" & vbNewLine & vbNewLine & _
              "This is line 1" & vbNewLine & _
              "This is line 2" & vbNewLine & _
              "This is line 3" & vbNewLine & _
              "This is line 4"

    On Error Resume Next
    With OutMail
        .To = "d.medvedev@controlgate.ru"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .Body = strbody

        'SendUsingAccount is new in Office 2007
        'Change Item(1)to the account number that you want to use
        .SendUsingAccount = OutApp.Session.Accounts.Item(1)

        .Send   'or use .Display
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub



Ещё для .SendUsingAccount надо достучаться до объектов Outlook.
Tools->refrences-> Microsoft Outlook xx.x Object Library
...
Рейтинг: 0 / 0
4 сообщений из 4, страница 1 из 1
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Отправка письма через определенную учетку
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]