avertissement outlookRésolu

Question

bonjour,

jai un gros probleme,
jai environ 300 mails a envoyer avec outlook en vba, mais 300 fois il va mafficher ce *!!*@#! de message davertissement qui dit qu'un programme tente denvoyer un mail patati patata...
n'y a t-il pas une clé de la base de registre à modifier pour eviter ça ??

meci davance

poum :-)

cs_Esquisse · Accepted Answer

Dans Outlook :

Menu, outil, onglet Sécurité
décoche 'M'avertir quand d'autres application essaie d'envoyer des messages de ma part'

et voila ;)

cs_crinblanc · Answer

Voilà une solution qui passe par VBSript et trouvée par l'armée américaine!!

Option Compare Database
Option Explicit

Function test_outlook()
Dim olApp As Outlook.Application
Dim olMailMessage As Outlook.MailItem
Dim pce_jointe As Outlook.Attachment
Dim fso, fsoFile, wshShell

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fsoFile = fso.CreateTextFile("c:\Bypass.vbs")
    fsoFile.WriteLine "Set fso = CreateObject(""WScript.Shell"")"
    fsoFile.WriteLine "While fso.AppActivate(""Microsoft Outlook"") = FALSE"
    fsoFile.WriteLine "wscript.sleep 1000"
    fsoFile.WriteLine "Wend"
    fsoFile.WriteLine "fso.SendKeys ""{TAB}"", TRUE"
    fsoFile.WriteLine "fso.SendKeys ""{TAB}"", TRUE"
    fsoFile.WriteLine "fso.SendKeys ""{+}"", TRUE"
    fsoFile.WriteLine "fso.SendKeys ""{TAB}"", TRUE"
    fsoFile.WriteLine "fso.SendKeys ""2"", TRUE"
    fsoFile.WriteLine "fso.SendKeys ""{TAB}"", TRUE"
    fsoFile.WriteLine "fso.SendKeys ""{ENTER}"", TRUE"
    fsoFile.WriteLine "wscript.sleep 7000"
    fsoFile.WriteLine "While fso.AppActivate(""Microsoft Outlook"") = FALSE"
    fsoFile.WriteLine "wscript.sleep 1000"
    fsoFile.WriteLine "Wend"
    fsoFile.WriteLine "fso.SendKeys ""{TAB}"", TRUE"
    fsoFile.WriteLine "fso.SendKeys ""{TAB}"", TRUE"
    fsoFile.WriteLine "fso.SendKeys ""{ENTER}"", TRUE"
    fsoFile.Close
    
    Set wshShell = CreateObject("Wscript.Shell")
    wshShell.Run ("c:\ByPass.vbs")
On Error Resume Next
' Crée une nouvelle instance de Microsoft Outlook ou ouvre l'instance actuelle.
    Set olApp = CreateObject("Outlook.Application")
    Set olMailMessage = olApp.CreateItem(olMailItem)
    With olMailMessage
        .Recipients.Add ("jp.jolinon@texenpartner.com")
        .Subject = "Mail automatique d'ACCESS sans Alarme OUTLOOK"
        .Body = "Voilà le code"
        Set pce_jointe = .Attachments.Add("c:\Bypass.txt")
        .Send
    End With
End Function

cs_crinblanc · Answer

Ou alors tu utilise çà et tu n'as plus besoin d'OUTLOOK

Déclare les références ADO et CDO dans ton module

Option Compare Database
Option Explicit

Public Sub MailEnvoi(Destinataire As String, Sujet As String, Optional Correspondant_CC As String, _
Optional Correspondant_BCC As String, Optional CorpsDuTexte As String, Optional Attach As Variant)
Dim objEmail
Set objEmail = CreateObject("CDO.Message")

    objEmail.From = "POLO@toto.com"
    objEmail.To = Destinataire
    objEmail.CC = Correspondant_CC
    objEmail.BCC = Correspondant_BCC
    objEmail.Subject = Sujet
    objEmail.TextBody = CorpsDuTexte
        If Attach <> "" Then objEmail.AddAttachment Attach
        
    objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

    'Name or IP of Remote SMTP Server
    objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "nom du serveur smtp"

    'Server port (typically 25)
    'objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25

    objEmail.Configuration.Fields.Update

    objEmail.Send

End Sub

Avertissement outlook

3 réponses

Discussions similaires