'pour éviter les erreurs de library ...
'- au lieu de faire -
'Dim MonOutlook As Outlook.Application
'- faire comme ceci et Excel va se servir de la bonne version de Outlook selon le poste
'Dim MonOutlook As Object
'Set MonOutlook = CreateObject("Outlook.Application")
'...
'ThisWorkbook.VBProject.References.AddFromFile
'Application.Version
Public Sub ActiveRef() 'Active la référence à Outlook selon la version d'excel
Dim AdresseRef As String, V As Integer
V = Val(Application.Version)
Select Case V
Case 7: '1995
'AdresseRef = "L'adresse du fichier"
Case 8: '1997
'AdresseRef = "L'adresse du fichier"
Case 9: '2000
'AdresseRef = "L'adresse du fichier"
Case 10: '2001
'AdresseRef = "L'adresse du fichier"
Case 11: '2003
AdresseRef = "c:\Program Files\Microsoft Office\OFFICE11\msoutl.olb"
Case 12: '2007
Case 13, 14: '2010
'AdresseRef = "L'adresse du fichier"
End Select
If AdresseRef > "" Then
On Error Resume Next
ThisWorkbook.VBProject.References.AddFromFile AdresseRef
On Error GoTo 0
End If
End Sub
Sub UseOutlook(strTo As String, strCC As String, strNomFichier As String, strSujet As String, strTexte As String)
Dim MonOutlook As Object
Dim MonMessage As Object
Dim strNomClasseur As String
Set MonOutlook = CreateObject("Outlook.Application")
Set MonMessage = MonOutlook.CreateItem(0)
strNomClasseur = strNomFichier
On Error GoTo fin
Sheets(strNomFichier).Copy
ActiveWorkbook.SaveAs ("c:\" & strNomFichier & ".xls")
strNomFichier = ActiveWorkbook.FullName
MonMessage.To = strTo
MonMessage.CC = strCC
MonMessage.Attachments.Add strNomFichier
MonMessage.Subject = strSujet
MonMessage.Body = strTexte
MonMessage.Send
Workbooks(strNomClasseur).Close SaveChanges:=False
Kill (strNomFichier)
Set MonOutlook = Nothing
Exit Sub
fin:
MsgBox Err.Description
Select Case Err.Number
Case 9
MsgBox "La valeur de la feuille est invalide" + vbCr + vbCr + "Opération annulé", vbCritical
Case 1004, 287
MsgBox "Une erreur est survenue durant la procédure" + vbCr + vbCr + "Opération annulé", vbCritical
Workbooks(strNomClasseur).Close SaveChanges:=False
Kill (strNomFichier)
End Select
Set MonOutlook = Nothing
Set MonMessage = Nothing
End Sub