Excel => Outlook

[david45]

bonjour a vous tous

je cherche un cod VBA pour envoyer un message par outlook a plusieur destinataire lorqu'une condition est vrai dans une cellule . pas de fichier joint mais juste un message du style 'tous va bien ' par exemple


merci par avance et a +

david

 

[Creepy]

Bonjour,

Voici ci dessous un code qui fait ca très bien. Attention il y a d'inclus la procédure pour contourner le pb de l'envoi automatique sous Outllok 2000 SP3 ou supérieur.

Si c'est ton cas, télécharge sur le net le petit outil ClickYes, sinon tu peux enlever les parties qui sont en italique.

Pour appeler la procédure :

If feuil1.range('B5').value = 'OK' then
   call Envoi_Mail
end if

@+

Creepy

Sub Envoi_Mail() 'Envoi auto d'un Mail en cas d'erreur(s)

On Error Resume Next

Dim OLF As Outlook.MAPIFolder, olMailItem As Outlook.MailItem
Dim wnd As Long
Dim uClickYes As Long
Dim Res As Long

Set OLF = GetObject('', 'Outlook.Application').GetNamespace('MAPI').GetDefaultFolder(olFolderInbox)
Set olMailItem = OLF.Items.Add

[i]' Procédure pour valider message SP3 outlook 2000
Shell ('C:\\Program Files\\Express ClickYes\\ClickYes.exe')
DoEvents
uClickYes = RegisterWindowMessage('CLICKYES_SUSPEND_RESUME')
wnd = FindWindow('EXCLICKYES_WND', 0&)
Res = SendMessage(wnd, uClickYes, 1, 0)[/i]

With olMailItem
   .Subject = 'Erreur dans le fichier le : ' & Date & ' ' & TIME
   .Recipients.Add ('dede@AOL.com')
   .Body = 'Erreur dans dudul le : ' & Date & ' ' & TIME
   .OriginatorDeliveryReportRequested = False
   .ReadReceiptRequested = False
   .Send
End With

[i]' Send the message to Suspend ClickYes
Res = SendMessage(wnd, uClickYes, 0, 0)
DoEvents
Call Kill_Process('ClickYes.exe')
DoEvents[/i]

Set olMailItem = Nothing
Set OLF = Nothing

End Sub
‘----------------------------------------------------------------
[i]Sub Kill_Process(Nom As String)

Dim Processus As PROCESSENTRY32

Capture = CreateToolhelp32Snapshot(2, 0)
Processus.DwSize = Len(Processus)
  
courant = Process32First(Capture, Processus)

Do While courant
   If Left$(Processus.SzExeFile, IIf(InStr(1, Processus.SzExeFile, Chr$(0)) > 0, InStr(1, Processus.SzExeFile, Chr$(0)) - 1, 0)) = Nom Then
   'Si 'xxx' est trouvé dans les processus du système, le parcours des processus s'arrete là
      courant = False
   Else
   'Processus suivant
      courant = Process32Next(Capture, Processus)
   End If
Loop
  
CloseHandle Capture
 
If TypeName(courant) = 'Boolean' Then
   Identifiant = OpenProcess(1, 0, Processus.Th32ProcessID)
   TerminateProcess Identifiant, 0
   CloseHandle Identifiant
End If
  
End Sub[/i]

 

[Creepy]

RE !!

L'italique marche pas dans le code c'est donc ce qui est entre les balise EM à supprimer.

Et puis j'ai oublié : Il faut activer dans VBA la référence Microsoft outlook pour que ca marche.

Message édité par: Creepy, à: 13/02/2006 12:11