is it possible to bypass or automatically reply to security warnings?

[SvenBlomme]

Hi,

Upon request of my colleagues I am trying to write a script to remove attachments from multiple selcted emails rather than on a mail by mail basis. The idea is to remove the attachments from the selected files, and to insert a stamp with the removed file name, file size, and date/time of removal.
I have based myself on codes I found on the internet and it seems to work fine.
However, at the end of the ride I get 2 security warnings ("a program is trying to access email address information stored in outlook" etc - I pasted the warning below the code). I highlighted the lines which fire the warning below in bold and Italic.
Is there a way to either prevent these security warnings from popping up, or to automatically answer these warnings with 'allow'?

Code:

Option Explicit
Public Sub ExportAttachments()
Dim objOL As Outlook.Application
Dim objMsg As Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long, lngCount As Long
Dim filesRemoved As String, fName As String, strDate As String
Dim alterEmails As Boolean
Dim result

result = MsgBox("Do you want to remove attachments from selected file(s)? ", vbYesNo + vbQuestion)
alterEmails = (result = vbYes)

Set objOL = CreateObject("Outlook.Application")
Set objSelection = objOL.ActiveExplorer.Selection

For Each objMsg In objSelection
If objMsg.Class = olMail Then
Set objAttachments = objMsg.Attachments
lngCount = objAttachments.Count
If lngCount > 0 Then
filesRemoved = ""
For i = lngCount To 1 Step -1
fName = objAttachments.Item(i).FileName
strDate = Now()
If alterEmails Then
If objAttachments.Item(i).size > 5200 Then
filesRemoved = filesRemoved & "<br>""" & objAttachments.Item(i).FileName & """ (" & _
formatSize(objAttachments.Item(i).size) & ") " & strDate
objAttachments.Item(i).Delete
End If
End If
skipfile:
Next i
If alterEmails Then
filesRemoved = "<b>Attachments removed</b>: " & filesRemoved & "<br><br>"
Dim objDoc As Object
Dim objInsp As Outlook.Inspector
Set objInsp = objMsg.GetInspector
Set objDoc = objInsp.WordEditor
objMsg.HTMLBody = filesRemoved + objMsg.HTMLBody
objMsg.Save
End If

End If
End If
Next

ExitSub:
Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing

End Sub

Function formatSize(size As Long) As String
Dim val As Double, newVal As Double
Dim unit As String

val = size
unit = "bytes"

newVal = Round(val / 1024, 1)
If newVal > 0 Then
val = newVal
unit = "KB"
End If
newVal = Round(val / 1024, 1)
If newVal > 0 Then
val = newVal
unit = "MB"
End If
newVal = Round(val / 1024, 1)
If newVal > 0 Then
val = newVal
unit = "GB"
End If

formatSize = val & " " & unit
End Function

warning during macro execution.png

[gmayor]

I don't get that error message here (Outlook 2010), and there is no need to either create a new Outlook application nor to use the word editor if you are only editing the message as you have described, if you are running the code from Outlook itself. You can therefore simplify the main code

Option Explicit
Public Sub ExportAttachments()
Dim objMsg As Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long, lngCount As Long
Dim filesRemoved As String, fName As String, strDate As String
Dim alterEmails As Boolean
Dim result As Long

    result = MsgBox("Do you want to remove attachments from selected file(s)? ", vbYesNo + vbQuestion)
    alterEmails = (result = vbYes)

    Set objSelection = ActiveExplorer.Selection

    For Each objMsg In objSelection
        If objMsg.Class = olMail Then
            If alterEmails Then
                With objMsg
                    Set objAttachments = .Attachments
                    lngCount = objAttachments.Count
                    If lngCount > 0 Then
                        filesRemoved = ""
                        For i = lngCount To 1 Step -1
                            fName = objAttachments.Item(i).Filename
                            strDate = Now()
                            If objAttachments.Item(i).size > 5200 Then
                                filesRemoved = filesRemoved & "<br>""" & objAttachments.Item(i).Filename & """ (" & _
                                               formatSize(objAttachments.Item(i).size) & ") " & strDate
                                objAttachments.Item(i).Delete
                            End If
                        Next i
                        filesRemoved = "<b>Attachments removed</b>: " & filesRemoved & "<br><br>"
                        .HTMLBody = filesRemoved + objMsg.HTMLBody
                        .Save
                    End If
                End With
            End If
        End If
    Next objMsg
ExitSub:
    Set objAttachments = Nothing
    Set objMsg = Nothing
    Set objSelection = Nothing
End Sub

[Bob Phillips]

Take a look at Redemption

[skatonni]

I have based myself on codes I found on the internet ...

Set objOL = CreateObject("Outlook.Application")
Set objSelection = objOL.ActiveExplorer.Selection

There are ways to bypass the security prompt but it is simpler to not trigger it at all.

A lot of code on the internet is set up for Outlook to be called from other applications, for example Excel.

When the code is in Outlook drop Set objOL = CreateObject("Outlook.Application") and use

Set objSelection = Application.ActiveExplorer.Selection

or simply

Set objSelection = ActiveExplorer.Selection

(If you some time want to call Outlook from Excel and you have Outlook already open you can use GetObject rather than CreateObject.)

[SvenBlomme]

Thanks a million to all of you for your input, I will try these options for sure and will let you know if it worked well!

[SvenBlomme]

Hi gmayor and Skatonni, I tested it again and it works fantastic!
You are amazing!!