envoye automatique de mail Fermé

Question

Bonjour  a tous ,
j'ai commencé a programmer depuis près de deux mois ,et grace a votre aide je vois que je fais des exploits en clair des choses que je ne pensais ou croyais faire un jour.
merci

aujourd'hui je me suis lancé sur les macros outlook
j'ai  écris une macro qui me permet d'envoyer des mails a plusieurs liste .
disons que j'ai 7 message a envoyer 
pour chaque message une liste de destinataire bien precise 
et des pieces jointes associées 
la  macro me permet aussi de joindre les dossiers que je veux en pieces jointes a chaque message
du coup quand je compile je vois apparaître les 7 fenetre d'envoie des mail 
et il ne me reste qu'a cliquer  sur chaque fenêtre envoyer et sa part


moi ce que je veux faire, c'est creer un bouton qui appelera macro et envoie automatiquement  les mails 

en d'autres termes le code vba ou autre pour l'envoie de mail automatiquement 
de sorte a ne plus voir les fenetres des 7 mail



j'espere que j'ai ete assez clair 
je me tiens a votre disposition pour toutes autres informations complementaires

Salutations

Chrispr07


Configuration: Windows / Chrome 36.0.1985.143

chrispr07 · Answer

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

chrispr07 · Answer

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

Envoye automatique de mail

2 réponses

Discussions similaires