Sub MAJ_Inscriptions()
Dim monOutlook As Object
Dim monNamespace As Object
Dim repForm As Object, repForm2 As Object
Dim nbMails As Integer, i As Integer, j As Integer
Dim ContenuMail As String
Dim formation As Integer, session As Integer
Dim Nom As String, Prenom As String, Service As String, Telephone As String, Email As String
Dim NomClasseur As String
Set monOutlook = CreateObject("Outlook.Application")
Set monNamespace = monOutlook.GetNamespace("MAPI")
Set repForm = monNamespace.Folders(1).Folders("Formations")
Set repForm2 = repForm.Folders("Traités")
nbMails = repForm.Items.Count
i = 0
While i < nbMails
ContenuMail = repForm.Items(1).Body
i = i + 1
' Récupération des valeurs dans le corps du Mail
Tableau = Split(ContenuMail, ";")
formation = Tableau(0)
session = Tableau(1)
Nom = Tableau(2)
Prenom = Tableau(3)
Service = Tableau(4)
Email = Tableau(5)
Telephone = Tableau(6)
' Ouverture du fichier Excel de la formation et session concernée
ChDir ThisWorkbook.Path
Workbooks.Open Filename:=ThisWorkbook.Path & "\Formation" & formation & ".xls"
Windows("Formation" & formation & ".xls").Activate
Sheets("" & session & "").Select
' Détection de la première ligne vide du tableau
j = Range("A65536").End(xlUp).Row + 1
' Insertion des valeurs et mise en forme
Cells(j, 1).Value = Nom
Cells(j, 2).Value = Prenom
Cells(j, 3).Value = Service
Cells(j, 4).Value = Telephone
Cells(j, 5).Value = Email
Cells(4, 5).Value = Cells(4, 5).Value + 1
'mise en forme
Range(Cells(j - 1, 1), Cells(j - 1, 5)).Select
Selection.Copy
Range(Cells(j, 1), Cells(j, 5)).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Cells(j + 2, 1).Select
ActiveWorkbook.Save
ActiveWindow.Close
' Le mail est marqué comme lu et déplacé dans "Traités"
repForm.Items(1).UnRead = False
repForm.Items(1).Move repForm2
End Sub
)
