Sub EnvoiMail_Bi()
Dim iMsg As Object, iConf As Object
Dim WBname As String, FchBI As String, smtp As String
Dim WB1 As Workbook
Dim Flds As Variant
FchBI = Range("FchBI")
smtp = Sheets("Rv").Range("B40")
Application.ScreenUpdating = False
Sheets("B d'intervention").Copy
Set WB1 = ActiveWorkbook
WBname = "Fiche " & FchBI & " " & Format(Date, "dd-mm-yy") & ".xls"
WB1.SaveAs "C:/" & WBname
WB1.Close False
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = smtp ' "SMTP.orange.fr"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
End With
With iMsg
Set .Configuration = iConf
.To = (ThisWorkbook.Sheets("Rv").Range("B39"))
.CC = ""
.BCC = ""
.From = """Gix"" <Gix@xld.fr>"
.Subject = "Travaux à effectuer"
.TextBody = "Veuillez trouver ci-joint le fichier ..."
.AddAttachment "C:/" & WBname
.Send
End With
Kill "C:/" & WBname
Set iMsg = Nothing
Set iConf = Nothing
Set WB1 = Nothing
Application.ScreenUpdating = True
End Sub