Geek asks and answers

How can I suppress an Outlook warning when sending mail using a macro in excel

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

But when I run this code, my email client, that is, MS Outlook displays a pop-up warning similar to  Someone is tying to send mail on behalf of you. select yes or no

Is it possible to use vba to suppress this warning in order to send an email message without any problems?

+5
source share
7 answers

The best way I know is to create an outlook application element, create a message, display a message and use sendkeys to send the message (equivalent to entering s text).

, sendkeys . , , , , sendkeys. :

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

, , , , 2 , . 5 . 5- , .

, excel, , , , .

+4

- . "" .

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 = " <Receipient1@domain.com>;  <Receipient2@domain.com"
    .Subject = "Your Subject Here"
    .HTMLBody = "Your message body here"
    .Send
End With

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


End Function
0

, , . Outlook. . .

0

:

  1. (Outlook )
  2. MAPI ( C++ Delphi, VB .Net). Redemption, Extended MAPI, , VBS.
  3. , ClickYes.

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

0
source

This Outlook VBA will download an Excel file with emails saved as records and send them all.

Option Explicit

 Private Const xlUp As Long = -4162

Sub SendEmailsFromExcel()

    Dim xlApp As Object

    Dim isEmailTo As String    ' Col A
    Dim isSubject As String    ' Col B
    Dim isMessage As String    ' Col C

    Dim i As Integer
    Dim objMsg As MailItem
    Set objMsg = Application.CreateItem(olMailItem)

    Dim emailsMatrix As Variant

    Dim objWB As Object
    Dim objWs As Object
    Dim FileStr As String

    FileStr = "C:\Users\kswerling\Documents\EmailsInExcel.xlsx"

    Set xlApp = CreateObject("excel.application")

    With xlApp
        .EnableEvents = False
        .DisplayAlerts = False
    End With

    Set objWB = xlApp.Workbooks.Open(FileStr)
    Set objWs = objWB.Sheets(1)

    ' Matrix load:  A - Email Address, B - Subject, C - Body
    emailsMatrix = objWs.Range("A1:C" & xlApp.Cells(objWs.Rows.Count, "A").End(xlUp).Row)

    objWB.Close

    Set objWB = Nothing
    xlApp.Quit
    Set xlApp = Nothing

'   Done getting Excel emails file.

    For i = 1 To UBound(emailsMatrix)
        isEmailTo = emailsMatrix(i, 1)
        isSubject = emailsMatrix(i, 2)
        isMessage = emailsMatrix(i, 3)


        objMsg.Recipients.Add isEmailTo
        objMsg.Subject = isSubject
        objMsg.Body = isMessage
        objMsg.Send
    Next i

End Sub
0
source

Adding to Julia Grant answer and dsauce answer

When I used Julia’s code directly, I got an error. RegisterWindowMessageThis should be fixed by replacing Private Declare Functionwith Declare PtrSafe Functionin

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 = " <Receipient1@domain.com>;  <Receipient2@domain.com"
    .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 that the branch is old, but it can help someone

-2
source

More articles:


All Articles