1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66
|
For n = 3 To 10
' Création des différents fichiers : je met pas le code car il est long mais il marche bien
'enregistrement des fichiers :
Workbooks("fievide.xls").SaveAs Filename:="D:\Documents and Settings\wboudgui\Desktop\test17juillet\fiches-crees\" & nom & ".xls"
Workbooks(nom & ".xls").Close False
'''envoi des mails :
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
AttachMail = "D:\Documents and Settings\wboudgui\Desktop\test17juillet\fiches-crees\" & nom & ".xls"
strbody = "Information sur la mise à jour"
On Error Resume Next
With OutMail
.To = Workbooks("UPIFich.xls").Worksheets("Feuil1").Cells(n, 6).Value
'.CC = "Francois.pignon@free.fr;robin.des.bois@sherwood.gb"
.Subject = "fiche d'imput"
.BodyFormat = olFormatHTML
.HTMLBody = "Bonjour, <BR><BR>Ce message est un mail automatique, il vous informe que
"
If AttachMail <> "" Then
.Attachments.Add AttachMail
End If
.Display
SendKeys "^{ENTER}"
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
'Cette procédure temporise pendant le nombre
' de secondes qu'on lui transmet en argument
Dim Début As Long, Fin As Long, Chrono As Long
Début = Timer
Dim secondes As Interior
'secondes = 13
Fin = Début + 10
Do Until Timer >= Fin
DoEvents
Loop
Next
' Code permettant de fermer toutes les fenetres outlook après l'envoi car sinon elles restent ouvertes :
Dim objs As Object
Dim obj As Object
Dim strSQL As String
Dim strWMI As String
strWMI = "winmgmts:"
strSQL = "Select * From Win32_Process "
strSQL = strSQL & "where Name = 'OUTLOOK.EXE'"
Set objs = GetObject(strWMI).ExecQuery(strSQL)
For Each obj In objs
obj.Terminate
Next
Set objs = Nothing |
Partager