Avoiding Outlook Excessive Security Warnings

pozzo

Registered User.
Local time
Today, 00:53
Joined
Jan 23, 2004
Messages
26
Hello

I´m sending email from Access.

When Access calls Outlook I receive Excessive Security Warnings from Oulook asking me to choose 1 or 10 minutes of permission.

How can I avoid these annoying messages?

Thanks in advance

Renato
 
This is built-in to Outlook's security.

The only way to sidestep this is to use a 3rd party addin such as Redemption or modify your code so it does not access functions that are restricted by security mechanism.

What are you trying to do with the Outlook?
 
Avoiding Outlook Excessive Security Warnings - my code

Banana
Take a look at my code

Public Sub Send_mail()

Dim myoutlook As Outlook.Application
Dim MyMail As Outlook.MailItem
Dim Subjectline As String
Dim BodyFile As String
Dim AttchFile As String
Dim fso As FileSystemObject
Dim MyBody As TextStream
Dim MyBodyText As String
Dim objOneRecip As Outlook.Recipient
Dim Address As String
Dim strCnn As String

Set fso = New FileSystemObject
'Assunto
If Me.assunto <> "" Then
Subjectline$ = Forms!Mail_para_Grupos!assunto
Else
MsgBox "Digite o Assunto da Mensagem.É obrigatório!" & vbNewLine & vbNewLine, vbCritical, "PSDB/RS"
Forms!Mail_Gru_Pes_02_jun_05!assunto.SetFocus
Exit Sub
End If

'Arquivo texto para o corpo da Mensagem
If Me.texto <> "" Then
BodyFile$ = Forms!Mail_para_Grupos!texto
If fso.FileExists(BodyFile$) = False Then
MsgBox "The body file isn't where you say it is. " & vbNewLine & vbNewLine & "Quitting...", vbCritical, "I Ain't Got No-Body!"
Exit Sub
End If

Set MyBody = fso.OpenTextFile(BodyFile, ForReading, False, TristateUseDefault)

MyBodyText = MyBody.ReadAll

MyBody.Close
Else
BodyFile$ = ""
End If

Set myoutlook = New Outlook.Application

'********************************************

Set MyMail = myoutlook.CreateItem(olMailItem)
Dim Mail As String
Dim var As Variant
Dim varItm As Variant
Dim lst1 As Access.ListBox
'Dim lst2 As Access.ListBox
'Dim lst3 As Access.ListBox
'Seleciona todos os itens das Listas de Mail Para, com Cópia Para e com cópia Oculta Para
' SelTodosItensList
Set lst1 = Me![lstSelectContacts]
' Set lst2 = Me![lstSelectContactsCC]
' Set lst3 = Me![lstSelectContactsBCC]
' If lst1.ItemsSelected.Count = 0 Then
' MsgBox "Selecione e Adicione, pelo menos, um Nome."
' Exit Sub
' End If
' mail's tipo: Para
tipo_mail = 1
SelTodosItensList
If lst1.ItemsSelected.Count = 0 Then
MsgBox "Adicione e Selecione, pelo menos, um Nome em Mail Para."
' Me.grupo.SetFocus
Exit Sub
End If

For Each varItm In Me.lstSelectContacts.ItemsSelected
Mail = Mail & Me.lstSelectContacts.ItemData(varItm)
Next varItm
Debug.Print Mail
For Each var In Me.lstSelectContacts.ItemsSelected
Debug.Print Me.lstSelectContacts.ItemData(var)
Mail = Me.lstSelectContacts.ItemData(var)
On Error GoTo erro
Set objOneRecip = MyMail.Recipients.Add(Mail)


objOneRecip.Type = olTo
Next var

' mail's tipo: Com Cópia Para
tipo_mail = 2
SelTodosItensList
For Each varItm In Me.lstSelectContactsCC.ItemsSelected
Mail = Mail & Me.lstSelectContactsCC.ItemData(varItm)
Next varItm
Debug.Print Mail
For Each var In Me.lstSelectContactsCC.ItemsSelected
Debug.Print Me.lstSelectContactsCC.ItemData(var)
Mail = Me.lstSelectContactsCC.ItemData(var)
Set objOneRecip = MyMail.Recipients.Add(Mail)
objOneRecip.Type = olCC
Next var

' mail's tipo: Com Cópia Oculta Para
tipo_mail = 3
SelTodosItensList
For Each varItm In Me.lstSelectContactsCC.ItemsSelected
Mail = Mail & Me.lstSelectContactsCC.ItemData(varItm)
Next varItm
Debug.Print Mail
For Each var In Me.lstSelectContactsBCC.ItemsSelected
Debug.Print Me.lstSelectContactsBCC.ItemData(var)
Mail = Me.lstSelectContactsBCC.ItemData(var)
Set objOneRecip = MyMail.Recipients.Add(Mail)
objOneRecip.Type = olBCC
Next var


'******************************************
MyMail.Subject = Subjectline$

MyMail.Body = MyBodyText

If Me.anexo <> "" Then
AttchFile$ = Forms!Mail_Gru_Pes_02_jun_05!anexo
MyMail.Attachments.Add AttchFile$, olByValue
Else
AttchFile$ = ""
End If

MyMail.Display

Set MyMail = Nothing

Set myoutlook = Nothing

tipo_mail = 1
DelTodosReg ("PessoasMail")
EliminaSelItensList
Me.lstSelectContacts.Requery
' Me.nome_grupo_to = ""
Me.qtde_to = ""
tipo_mail = 2
DelTodosReg ("PessoasMailCC")
EliminaSelItensList
Me.lstSelectContactsCC.Requery
' Me.nome_grupo_cc = ""
Me.qtde_cc = ""
tipo_mail = 3
DelTodosReg ("PessoasMailBCC")
EliminaSelItensList
Me.lstSelectContactsBCC.Requery
' Me.nome_grupo_bcc = ""
Me.qtde_bcc = ""
EliminaSelItensList
tipo_mail = 4 'Pessoas
DelTodosReg ("PessoasMailEsc")
EliminaSelItensList
Me.lstSelectPessoas.Requery
' Me.nome_grupo_bcc = ""
' Me.qtde_bcc = ""
EliminaSelItensList
erro:
Exit Sub

End Sub
 
Glad to see that you've found the solution. Also, thanks for posting back. :)
 

Users who are viewing this thread

Back
Top Bottom