[VBA] Envoi de mail avec Outlook sans message d'alerte

Bonjour,

Il existe ceci, tu as des explications supplémentaires à l'adresse du site Web.
Perso. Je n'ai jamais eu à utiliser ceci.

Une autre alternative serait d'utiliser CDO, dis-le si cela t'intéresse!

À mettre dans un module standard...

Code Associated with Click me
http://www.contextmagic.com/express-clickyes/

' Microsoft Visual Basic (VB/VBA) Sample
' Declare Windows' API functions

Private Declare Function RegisterWindowMessage _
Lib "user32" Alias "RegisterWindowMessageA" _
(ByVal lpString As String) As Long

Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As Any, _
ByVal lpWindowName As Any) As Long

Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long

'--------------------------------------------------------------------------
Sub SomeProc()
Dim wnd As Long
Dim uClickYes As Long
Dim Res As Long

' Register a message to send
uClickYes = RegisterWindowMessage("CLICKYES_SUSPEND_RESUME")

' Find ClickYes Window by classname
wnd = FindWindow("EXCLICKYES_WND", 0&)

' Send the message to Resume ClickYes
Res = SendMessage(wnd, uClickYes, 1, 0)

' ...
' Do some Actions
' ...

' Send the message to Suspend ClickYes
Res = SendMessage(wnd, uClickYes, 0, 0)

End Sub
'----------------------------------------------------------------------

MichD

Une autre alternative serait d'utiliser CDO, dis-le si cela
t'intéresse!

L'inconvénient de CDO est que le mot de passe de la messagerie est alors
en clair dans le VBA.

À mettre dans un module standard...
Code Associated with Click me

Par contre, Click me ne fonctionne que lorsque l'on a l'alerte Outlook.
Mon souci est que pour plus d'un mail l'alerte ne s'affiche pas. La
boucle d'envoi continue son petit chemin sans aucun message d'alerte ou
message d'erreur...

@+
HD

Bonjour

Voyez :
http://faq-outlook.fr/articles.php?article_id01

Sur ce site, tu as un tas d'exemples pour Mac ou Windows.
http://www.rondebruin.nl/search.htm

P.S. Outlook ne fonctionne pas. Je ne peux pas effectuer de tests.

MichD

Si cela te tente, essaie cette procédure :

Tout ce qui suit dans le même module standard.

Certaines lignes peuvent être coupées par le service de messagerie, il faut alors remettre sur une
même ligne le cas échéant. La procédure n'a pas été testée sur une version Excel 2010.

'Déclaration des API dans le haut du module standard.
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String,
ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal
hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function SendMessageLong& Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long,
ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Function ClickYes() As Long
Dim A As Long
Dim B As Long
A = FindWindow("#32770", "Microsoft Outlook")
B = FindWindowEx(A, 0, "Button", "Yes")
ClickYes = B
End Function
Function ClickYesOne() As Long
Dim A As Long
Dim B As Long
A = FindWindow("#32770", "Microsoft Outlook")
B = FindWindowEx(A, 0, "Button", "&Yes")
ClickYesOne = B
End Function
Private Sub Timer1_Timer()
SendMessageLong ClickYes, WM_LBUTTONDOWN, 0&, 0&
SendMessageLong ClickYes, WM_LBUTTONUP, 0&, 0&
SendMessageLong ClickYesOne, WM_LBUTTONDOWN, 0&, 0&
SendMessageLong ClickYesOne, WM_LBUTTONUP, 0&, 0&
End Sub

'-------------------------------------------------------------
Sub SendMail()
Dim C As Range
Dim outl As Outlook.Application
Set outl = New Outlook.Application
Dim mi As Outlook.MailItem

Call Timer1_Timer

'nom feuille et adresse de la plage de cellules à adapter
With Worksheets("Feuil1")
'un tableau de données
For Each C In .Range("A1:A4")
Set mi = outl.CreateItem(olMailItem)
'En colonne A, adresse des destinataires
mi.To = C.Value ' "Michdenis@Hotmail.com" 'destinataire
'En colonne B, l'objet du courriel
mi.Subject = C.Offset(, 1).Value
'En colonne C, le corps du message
mi.Body = C.Offset(, 2).Value 'corps du message
'En Colonne D, le chemin et le nom du fichier
If C.Offset(, 2) <> "" Then
If Not IsNumeric(C.Offset(, 2)) Then
If IsDate(C.Offset(, 2).Value) = False Then
If Dir(C.Offset(, 2).Value) <> "" Then
mi.Attachments.Add C.Offset(, 2).Value
End If
End If
End If
End If
mi.Send
Set mi = Nothing
Next
End With
Set outl = Nothing
End Sub
'-------------------------------------------------------------

MichD

Si cela ne fonctionne pas, dans la procédure "SendMail", déplace cette ligne de code
Call Timer1_Timer juste avant la ligne de code mi.send

MichD

Bonjour,

J'ai fini par me résoudre à utiliser le CDO. Cela fonctionne très bien.
Merci de votre aide.

Cordialement,

DAH