Discussion: Excel => Outlook
Afficher un message
Vieux 13/02/2006, 11h56   #2 (permalink)
Creepy
XLDnaute Accro
 
Avatar de Creepy
 
Date d'inscription: février 2005
Version Excel : Excel 2003 (PC)
Messages: 1 468
Par défaut Re:Excel => Outlook

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 :

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

Creepy

Code:
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

' 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)

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

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

Set olMailItem = Nothing
Set OLF = Nothing

End Sub
‘----------------------------------------------------------------
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
__________________
Creepy est déconnecté   Réponse avec citation