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

12747

[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 (http://www.dimastr.com/redemption/home.htm)

[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!!