Envoye automatique de mail

voici mes differents codes

Sub PLANNING()

Dim Message, Title, Default_week, Week_number, Week_activity, mtp_number
Dim check_folder, check_FTP, check_MidTP, check_ZIP
Dim weekly_folder
Dim FT_plan, MidTerm_plan, EASA_ZIP, FT_Military_Plan, MidTerm_Military_Plan

MsgBox "DONT FORGET THE RELEASE TO OPS !!!"

' Identification of Folder and Files

Message = "Please insert current week number : "

Title = "WEEK NUMBER FOR MESSAGES TITLE"

' MsgBox "DateValueNow" & DateValue(Now())

' ctrl_date_1jan = DateValue("01 janvier 2013")

' MsgBox "jan 2013" & ctrl_date_1jan

'ctrl_date_1jan = DateValue("january 01, 2012")

'MsgBox "jan 2012" & ctrl_date_1jan

'MsgBox "DateValuejanuary 01, 2012 " & DateValue("january 01, 2012")

Default_week = Round(((DateValue(Now()) - DateValue("01 janvier 2014")) + 2) / 7)

' Default_week = 11

Week_number = InputBox(Message, Title, Default_week)

If Week_number < 51 Then
Week_activity = Week_number + 1
Else
Message = "Please insert activity week number to export : "
Week_activity = InputBox(Message, Title, 1)
End If

mtp_number = Week_activity + 1

If Week_number < 10 Then
weekly_folder = "\\Sfs.corp\projects\NG\FLIG_OP\EVT_PLAN\Gazette EVT\2014\0" & Week_number

Else
weekly_folder = "\\Sfs.corp\projects\ENG\FLIGHT_OP\EVT_PLAN\Gazette EVT\2014\" & Week_number

End If

Set check_folder = CreateObject("Scripting.FileSystemObject")

If check_folder.FolderExists(weekly_folder) Then

FT_plan = weekly_folder & "\EVT Flight test plan " & Week_activity & ".xls"
MidTerm_plan = weekly_folder & "\EVT Mid term plan " & mtp_number & ".xls"
EASA_ZIP = weekly_folder & "\EVT Flight Test Activity " & Week_activity & ".zip"
FT_My_Plan = weekly_folder & "\EVT A400M Flight Test plan " & Week_activity & ".xls"
MidTerm_Military_Plan = weekly_folder & "\EVT A400M Mid term plan " & mtp_number & ".xls"

Set check_FTP = CreateObject("Scripting.FileSystemObject")
Set check_MidTP = CreateObject("Scripting.FileSystemObject")
Set check_ZIP = CreateObject("Scripting.FileSystemObject")
Set check_MIL = CreateObject("Scripting.FileSystemObject")
Set check_MIL_MidTP = CreateObject("Scripting.FileSystemObject")

' Creation of Message for EV ---------------------------------------------------------

If check_FTP.FileExists(FT_plan) And check_MidTP.FileExists(MidTerm_plan) Then

Set Message_EV = Application.CreateItem(0)

Message_EV.Subject = "EVT Flight Test Plan Week " & Week_activity

Set Message_EV_Attachments = Message_EV.Attachments
Message_EV_Attachments.Add (FT_plan)
Message_EV_Attachments.Add (MidTerm_plan)

Message_EV.Recipients.Add ("Gazette EV ext")
Message_EV.Recipients.Add ("Gazette EV int 1")
Message_EV.Recipients.Add ("Gazette EV int 2")

Message_EV.Display

End If

' Creation of Message Flight Test Plan ------------------------------------------------

If check_FTP.FileExists(FT_plan) Then

Set Message_FTPlan = Application.CreateItem(0)

Message_FTPlan.Subject = "EVT Flight Test Plan " & Week_activity

Set Message_FTPlan_Attachments = Message_FTPlan.Attachments
Message_FTPlan_Attachments.Add (FT_plan)

Message_FTPlan.Recipients.Add ("EVT Flight test plan 1")
Message_FTPlan.Recipients.Add ("EVT Flight test plan 2")

Message_FTPlan.Display

Else: MsgBox "File " & FT_plan & " does not exist"

End If

' Creation of Message Mid Term Plan --------------------------------------

If check_MidTP.FileExists(MidTerm_plan) Then

Set Message_MTP = Application.CreateItem(0)

Message_MTP.Subject = "EVT Mid Term Plan Week " & mtp_number

Set Message_MTP_Attachments = Message_MTP.Attachments
Message_MTP_Attachments.Add (MidTerm_plan)

Message_MTP.Recipients.Add ("EVT Mid term plan")

Message_MTP.Display

Else: MsgBox "File " & MidTerm_plan & " does not exist"

End If

' Creation of Message EASA ------------------------------------------------

If check_ZIP.FileExists(EASA_ZIP) Then

Set Message_EASA = Application.CreateItem(0)

Message_EASA.Subject = "EVT Flight Test activity " & Week_activity

Set Message_EASA_Attachments = Message_EASA.Attachments
Message_EASA_Attachments.Add (EASA_ZIP)

Message_EASA.Recipients.Add ("EASA")

Message_EASA.Display

Else: MsgBox "File " & EASA_ZIP & " does not exist"

End If

' Creation of Message MILITARY ------------------------------------------------

If check_MIL.FileExists(FT_Military_Plan) And check_MIL_MidTP.FileExists(MidTerm_Military_Plan) Then

Set Message_MIL = Application.CreateItem(0)

Message_MIL.Subject = "EVT A400M Flight Test activity " & Week_activity

Set Message_MIL_Attachments = Message_MIL.Attachments
Message_MIL_Attachments.Add (FT_Military_Plan)
Message_MIL_Attachments.Add (MidTerm_Military_Plan)

Message_MIL.Recipients.Add ("EVT A400M Mid term plan")
Message_MIL.Recipients.Add ("EVT A400M Mid term plan 2")

Message_MIL.Display

Else: MsgBox "File " & FT_Military_Plan & " or " & MidTerm_Military_Plan & " does not exist"

End If

' Creation of Message EASA nbr 2 (Plannings avail in I-Share)------------------------------------------------

MsgBox "Copy A400M Plannings in I-SHARE !!! Click OK once completed"

Set Message_EASA_2 = Application.CreateItem(0)

Message_EASA_2.Subject = "EVT A400M Flight Test activity " & Week_activity & " : planning files available"

Message_EASA_2.Body = "Please be informed that planning files for EVT A400M Flight Test activity for week " & Week_activity & " and for Mid term are available in the A400M Flight Test Planning I-Share" & Chr(10) & Chr(10)

Message_EASA_2.Recipients.Add ("A400M_planning_avail")

Message_EASA_2.Display

' End of message creation --------------------------------------------------

Else: MsgBox "Folder " & weekly_folder & " does not exist"

End If

End Sub

Sub ExportCal2XML()
Const NODE_PROCESSING_INSTRUCTION = 7
Const NODE_ELEMENT = 1

Dim objDOM As Object, _
objCalendar As Object, _
objCal As Object, _
objP As Object, _
objData As Object, _
olkItems As Outlook.Items, _
olkAppt As Outlook.AppointmentItem, _
datStart As Date, _
datEnd As Date, _
intCount As Integer

' Create the main xml node '
Set objDOM = CreateObject("MSXML2.DOMDocument")
Set objCalendar = objDOM.createNode(NODE_PROCESSING_INSTRUCTION, "xml", "")
objDOM.appendChild objCalendar

' Create the Parent Node - "calendar" '
Set objCalendar = objDOM.createNode(NODE_ELEMENT, "calendar", "")

' Create a child node - "cal" '
Set objCal = objDOM.createNode(NODE_ELEMENT, "cal", "")

' Get the Outlook calendar items '
'datStart = Month(Date) & "/1/" & Year(Date)
' SG
datStart = DateValue(Now())

' datEnd = DateAdd("m", 3, datStart)
datEnd = DateAdd("d", 7, datStart)

MsgBox datStart & " " & datEnd

Set olkItems = Session.GetDefaultFolder(olFolderCalendar).Items.Restrict("[Start] > '" & Format(datStart & " 0:01am", "ddddd h:nn AMPM") & "' AND [Start] < '" & Format(datEnd & " 23:59pm", "ddddd h:nn AMPM") & "'")
For Each olkAppt In olkItems
Set objP = objDOM.createNode(NODE_ELEMENT, "p", "")
objCal.appendChild objP
' Add Start '
Set objData = objDOM.createNode(NODE_ELEMENT, "Start", "")
objData.Text = olkAppt.Start
objP.appendChild objData

'SG
' Add Duration '
Set objData = objDOM.createNode(NODE_ELEMENT, "duration", "")
objData.Text = olkAppt.Duration
objP.appendChild objData

'SG
' Add Category '
Set objData = objDOM.createNode(NODE_ELEMENT, "category", "")
objData.Text = olkAppt.Categories
objP.appendChild objData

' Add Memo_Title '
Set objData = objDOM.createNode(NODE_ELEMENT, "memo_title", "")
objData.Text = olkAppt.Subject
objP.appendChild objData
' Add Memo_Details '
Set objData = objDOM.createNode(NODE_ELEMENT, "memo_details", "")
objData.Text = olkAppt.Body
objP.appendChild objData
' Add the data to the Cal node '
objCal.appendChild objP
Set objP = Nothing
intCount = intCount + 1
Next

' Append "Cal" to "Calendar" '
objCalendar.appendChild objCal
Set objCal = Nothing

' Append "Calendar" to the XML Dom Document '
objDOM.appendChild objCalendar
Set objCalendar = Nothing

' Change the name and path of the output file.'
objDOM.Save "C:\Users\EVT_ADMIN\Documents\TEMP_TEST\Test_export_cal.xml"

' Cleanup '
Set objDOM = Nothing
Set objCalendar = Nothing
Set objCal = Nothing
Set objP = Nothing
Set objData = Nothing
Set olkItems = Nothing
Set olkAppt = Nothing
MsgBox "Process complete. Exported " & intCount & " items.", vbInformation + vbOKOnly, "Export Calendar to XML"
End Sub