Sub EnvoyerMail1()
Dim i As Integer
Dim NomDeLaFeuille As String
Dim NomDesClasseurs(1 To 11)
Dim ZonePJ As Range
Set ZonePJ = Range("C18:C28")
For i = 18 To 28
If Not IsEmpty(Range("C" & i)) And Range("D" & i) = "OK" Then
NomDeLaFeuille = Range("C" & i)
NomDesClasseurs(i - 18 + 1) = "C:\Documents and Settings\user\Mes documents\" & NomDeLaFeuille & ".xls"
ThisWorkbook.Sheets(NomDeLaFeuille).Copy
ActiveWorkbook.SaveAs ("C:\Documents and Settings\user\Mes documents\" & NomDeLaFeuille)
ActiveWorkbook.Close
End If
Next i
[COLOR="Red"]Range("C34").Value = NomDesClasseurs(i1);NomDesClasseurs(i2);NomDesClasseurs(i3);etc[/COLOR]
Dim D As String
Dim CC As String
Dim E As String
Dim S As String
Dim T As String
Dim pj As String
D = Range("C33").Value
CC = Range("C35").Value
E = Range("C15").Value
S = Range("C3").Value
T = Range("C6").Value & Chr(10) & Chr(10) & Range("C9").Value
[COLOR="Red"]pj = Range("C34").Value[/COLOR]
Dim Cdo_Message As New CDO.Message
Set Cdo_Message.Configuration = GetSMTPServerConfig()
With Cdo_Message
.To = D
.CC = CC
.From = E
.Subject = S
.TextBody = T
If Not IsMissing(pj) Then
.AddAttachment pj
End If
.send
End With
success = MsgBox(" envoyés avec succès !", vbInformation)
Exit Sub
SMTPSendMail_Err:
'Gestion des erreurs
tmp = MsgBox("Erreur lors de l'envoi de votre message." & Chr(10) & "Détails : " & Err.Description, vbCritical)
For i = 1 To 11
If NomDesClasseurs(i) <> "" Then Kill NomDesClasseurs(i)
Next
ZonePJ.ClearContents
End Sub