How can I supress the Outlook warning while sendin

问题:

I am trying to send an email using macro in excel.

But when I run this code my mail client i.e. MS Outlook shows a pop up warning similar to
Someone is tying to send mail on behalf of you. select yes or no

Is there any way using vba to suppress that warning so the email should be sent without any problem?

回答1:

The best way I know is to create an outlook application item, create the message, display the message and use sendkeys to send the message (equivelent of typing alt s).

The drawback is that the sendkeys method can be a bit buggy. To make it more robust I get the inspector for the mail item i.e. the window it is in and activate it immediately prior to the call to sendkeys. The code is shown below:

Dim olApp As outlook.Application
Dim objNS As Outlook.Namespace
Dim objMail As Outlook.MailItem
Dim objSentItems As Outlook.MAPIFolder
Dim myInspector As Outlook.Inspector

'Check whether outlook is open, if it is use get object, if not use create object
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If olApp Is Nothing Then
    Set olApp = CreateObject("Outlook.Application")
End If

Set objNS = olApp.GetNamespace("MAPI")
objNS.Logon

'Prepare the mail object    
Set objMail = olApp.CreateItem(olMailItem)

With objMail
.To = <insert recipients name as string>
.Subject = <insert subject as string>
.Body = <insert message as string>
.Display   
End With

'Give outlook some time to display the message    
Application.Wait (Now + TimeValue("0:00:05"))

'Get a reference the inspector obj (the window the mail item is displayed in)
Set myInspector = objMail.GetInspector

'Activate the window that the mail item is in and use sendkeys to send the message
myInspector.Activate
SendKeys "%s", True

I normally then have code to check that the number of items in the sent folder has increased and if not I get the application wait again and repeat the last 2 lines of code and recheck that the number of messages in the sent folder has increased. The code does this upto 5 times. After the 5th time a message box comes up warning that the message may not have been sent.

I have never found this method to fail in sending a message from excel though I once saw the warning message when our system was particularly slow, on investigation it turned out that the message had been sent.

回答2:

You need use a Redemption DLL to disable this warning...

Download http://www.dimastr.com/redemption

I Created one way to install this DLL on machine automatic, you can try...

http://www.officevb.com/2011/02/copiando-e-registrando-componentes-na.html

回答3:

the window is popping up to begin with because the macro is not signed by a Trusted Publisher. This list in your Outlook settings. You must sign the macro and input the signer into your trusted publishers list. Or allow unsigned macros globally.

回答4:

I found the code below somewhere on the internet a couple of years ago. It automatically answers 'Yes' for you.

Option Compare Database
' Declare Windows' API functions
Private Declare Function RegisterWindowMessage _
        Lib "user32" Alias "RegisterWindowMessageA" _
        (ByVal lpString As String) As Long

 Private Declare Function FindWindow Lib "user32" _
            Alias "FindWindowA" (ByVal lpClassName As Any, _
            ByVal lpWindowName As Any) As Long


Private Declare Function SendMessage Lib "user32" _
        Alias "SendMessageA" (ByVal hwnd As Long, _
        ByVal wMsg As Long, ByVal wParam As Long, _
        lParam As Any) As Long

Function TurnAutoYesOn()
Dim wnd As Long
Dim uClickYes As Long
Dim Res As Long
uClickYes = RegisterWindowMessage("CLICKYES_SUSPEND_RESUME")
wnd = FindWindow("EXCLICKYES_WND", 0&)
Res = SendMessage(wnd, uClickYes, 1, 0)

End Function

Function TurnOffAutoYes()
Dim wnd As Long
Dim uClickYes As Long
Dim Res As Long
uClickYes = RegisterWindowMessage("CLICKYES_SUSPEND_RESUME")
wnd = FindWindow("EXCLICKYES_WND", 0&)
Res = SendMessage(wnd, uClickYes, 0, 0)
End Function


Function fEmailTest()

TurnAutoYesOn  '*** Add this before your email has been sent



Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
With MailOutLook
    .To = " <[e-mail]>;  <[e-mail]"
    .Subject = "Your Subject Here"
    .HTMLBody = "Your message body here"
    .Send
End With

TurnOffAutoYes '*** Add this after your email has been sent


End Function

回答5:

A few options:

1. Use up-to-date antivirus software (Outlook will not display a prompt then)
2. Extended MAPI (C++ or Delphi only, does not apply in case of VB script or .Net languages). You can however use a wrapper like Redemption that uses Extended MAPI but is accessible from any language including VBS.
3. A product like ClickYes.

See http://www.outlookcode.com/article.aspx?id=52 for a discussion and a list of available options.

回答6:

Adding to Julia Grant's Answer and Answering dsauce

When used Julia' Code directly I got the error RegisterWindowMessage This should be fixed by replacing Private Declare Function with Declare PtrSafe Function in the declaration section

Option Compare Database
' Declare Windows' API functions
Declare PtrSafe Function RegisterWindowMessage _
        Lib "user32" Alias "RegisterWindowMessageA" _
        (ByVal lpString As String) As Long

 Declare PtrSafe Function FindWindow Lib "user32" _
            Alias "FindWindowA" (ByVal lpClassName As Any, _
            ByVal lpWindowName As Any) As Long


Declare PtrSafe Function SendMessage Lib "user32" _
        Alias "SendMessageA" (ByVal hwnd As Long, _
        ByVal wMsg As Long, ByVal wParam As Long, _
        lParam As Any) As Long

Function TurnAutoYesOn()
Dim wnd As Long
Dim uClickYes As Long
Dim Res As Long
uClickYes = RegisterWindowMessage("CLICKYES_SUSPEND_RESUME")
wnd = FindWindow("EXCLICKYES_WND", 0&)
Res = SendMessage(wnd, uClickYes, 1, 0)

End Function

Function TurnOffAutoYes()
Dim wnd As Long
Dim uClickYes As Long
Dim Res As Long
uClickYes = RegisterWindowMessage("CLICKYES_SUSPEND_RESUME")
wnd = FindWindow("EXCLICKYES_WND", 0&)
Res = SendMessage(wnd, uClickYes, 0, 0)
End Function


Function fEmailTest()

TurnAutoYesOn  '*** Add this before your email has been sent



Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
With MailOutLook
    .To = " <[e-mail]>;  <[e-mail]"
    .Subject = "Your Subject Here"
    .HTMLBody = "Your message body here"
    .Send
End With

TurnOffAutoYes '*** Add this after your email has been sent


End Function

I know the thread is old, but it may help somebody