CODEWITHSUNDEEP
excelvbaoutlook
user1787114
user1787114

Reputation: 205

Give excel explicit control of outlook

I am trying to write a simple program to automatically send emails from a list in excel, and it works, but outlook keeps opening pop ups asking for permission. How do you get outlook to not ask for permission anymore and just do what excel tells it without the pop ups

Heres the code I have so far:

Sub SendMessage()

      Dim objOutlook As Outlook.Application
      Dim objOutlookMsg As Outlook.MailItem
      Dim objOutlookRecip As Outlook.Recipient
      Dim objOutlookAttach As Outlook.Attachment
      Dim recemail
      Dim i As Integer

      i = 1

      recemail = Sheet1.Cells(i, 1)

      ' Create the Outlook session.
      Set objOutlook = CreateObject("Outlook.Application")

      ' Create the message.
      Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

      With objOutlookMsg
          ' Add the To recipient(s) to the message.
          Set objOutlookRecip = .Recipients.Add(recemail)
          objOutlookRecip.Type = olTo

         ' Set the Subject, Body, and Importance of the message.
         .Subject = "TEST!"
         .Body = "DOES THIS WORK!?"

         ' Should we display the message before sending?
         If DisplayMsg Then
             .Display
         Else
             .Save
             .Send
         End If
      End With
      Set objOutlook = Nothing

      i = i + 1
  End Sub

Upvotes: 1

Views: 752

Answers (1)

R3uK
R3uK

Reputation: 14537

This is a manual operation that you need to do :

  1. Run Outlook as Administrator
  2. Go to Tools (Outlook 2007) or File, Options (Outlook 2010 and up)
  3. Go to Trust Center
  4. Change the Programmatic Access setting to : Never warn me about suspicious activity

You can now close Outlook and from now on, you'll have access every time without the popup!

BTW, to avoid opening a new instance of Outlook (if there is already one), use this :

  'Create or Get the Outlook session.
  On Error Resume Next
  Set objOutlook = GetObject(, "Outlook.Application")
  If Err.Number > 0 Then Set objOutlook = CreateObject("Outlook.Application")
  On Error GoTo 0

Upvotes: 1

Related Questions