使用Outlook在沒有安全警告的情況下從Excel發送電子郵件

Question

我正在使用Ron de Bruin網站上的代碼來使用Outlook通過Excel發送電子郵件。 我收到此安全警告“程序正在嘗試代表您發送電子郵件”，要求我允許或拒絕。

我如何避免此警告並直接發送電子郵件”

注意：我正在使用Excel 2007。

這是代碼：

Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim cell As Range

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

Sheets("" & Sheet & "").Select
With Sheets("" & Sheet & "")
    strbody = ""
End With

On Error Resume Next
With OutMail
    .To = " email1@a.com"
    .CC = ""
    .BCC = ""
    .Subject = ""
    .Body = strbody
    .From = ""
    .Send
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing

' restore default application behavior
Application.AlertBeforeOverwriting = True
Application.DisplayAlerts = True
ActiveWindow.SelectedSheets.PrintOut Copies:=3, Collate:=True

Answer 1

除了所描述的方法鏈接從評論，假設你是發送者“......要求我允許或拒絕”，如果你有運行Excel，你可以讓Outlook 已經運行也是如此。

最簡單的方法是：

Set OutApp = GetObject(, "Outlook.Application") 

Answer 2

幾年前，我在互聯網上的某個地方找到了下面的代碼。 它會自動為您回答“是”。

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