Discussion :

[HOUAFA]

Bonjour tout le monde,

Je reçois chaque jour une réclamation via outlook 365 depuis une adresse email spécifique sous format ci-aprés /

Bonjour,
Notification automatique de plateforme de supervision des machines:
Agence = AGDAL
Machine = MAC03
Description = HORS SERVICE
Heure = MAC03-200625_120400.xlsx

Cordialement,

L'objectif est de transférer à chaque réception de ce mail ces information en tableau excel nommé par défaut [MACH03-20/06/2025 12:00]comme exemple en pièce jointe et le sauvegarde automatiquement sur un répértoire spécifique dans mon ordinateur via script

[HOUAFA]

Merci d'avance pour votre aide et professionnalisme

[HOUAFA]

Bonjour tout le monde ,

je me permet de solliciter votre aide concernant le sujet en question. Je compte sur votre expertise pour m'aider à trouver une solution .

C'est bloquant SVP.

Merciii

[Nain porte koi]

Hello,

pas sur d'avoir tout compris...
Vu que je ne programme pas avec Outlook, voici une réponse de chatgpt

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    Dim ns As Outlook.Namespace
    Dim itm As Outlook.MailItem
    Dim xlApp As Object
    Dim xlBook As Object
    Dim xlSheet As Object
    Dim msgIDs() As String
    Dim entryID As String
    Dim bodyLines() As String
    Dim line As Variant
    Dim agence As String, machine As String, description As String, heureInfo As String
    Dim savePath As String, fileName As String, dateStr As String
    Dim regex As Object, matches As Object
 
    Set ns = Application.GetNamespace("MAPI")
    msgIDs = Split(EntryIDCollection, ",")
 
    For Each entryID In msgIDs
        Set itm = ns.GetItemFromID(entryID)
 
        ' Vérifier que l'élément est un email et l’expéditeur spécifique
        If itm.Class = olMail And itm.SenderEmailAddress = "adresse@email.com" Then
 
            ' Découper le corps du message ligne par ligne
            bodyLines = Split(itm.Body, vbCrLf)
            For Each line In bodyLines
                If InStr(line, "Agence") > 0 Then agence = Trim(Split(line, "=")(1))
                If InStr(line, "Machine") > 0 Then machine = Trim(Split(line, "=")(1))
                If InStr(line, "Description") > 0 Then description = Trim(Split(line, "=")(1))
                If InStr(line, "Heure") > 0 Then heureInfo = Trim(Split(Split(line, "=")(1), ".xlsx")(0))
            Next line
 
            ' Extraire date/heure du nom du fichier
            Set regex = CreateObject("VBScript.RegExp")
            With regex
                .Pattern = machine & "-(\d{2})(\d{2})(\d{2})_(\d{2})(\d{2})"
                .Global = False
                .IgnoreCase = True
            End With
 
            If regex.Test(heureInfo) Then
                Set matches = regex.Execute(heureInfo)
                If matches.Count > 0 Then
                    Dim YY, MM, DD, HH, MI As String
                    With matches(0)
                        DD = .SubMatches(0)
                        MM = .SubMatches(1)
                        YY = "20" & .SubMatches(2)
                        HH = .SubMatches(3)
                        MI = .SubMatches(4)
                    End With
                    dateStr = DD & "-" & MM & "-" & YY & " " & HH & "-" & MI
                    fileName = machine & "-" & dateStr & ".xlsx"
                Else
                    fileName = machine & "-ErreurDate.xlsx"
                End If
            Else
                fileName = machine & "-Invalide.xlsx"
            End If
 
            ' Créer Excel et remplir les données
            Set xlApp = CreateObject("Excel.Application")
            xlApp.Visible = False
            Set xlBook = xlApp.Workbooks.Add
            Set xlSheet = xlBook.Sheets(1)
 
            ' En-têtes
            xlSheet.Cells(1, 1).Value = "Agence"
            xlSheet.Cells(1, 2).Value = "Machine"
            xlSheet.Cells(1, 3).Value = "Description"
            xlSheet.Cells(1, 4).Value = "Heure"
 
            ' Données
            xlSheet.Cells(2, 1).Value = agence
            xlSheet.Cells(2, 2).Value = machine
            xlSheet.Cells(2, 3).Value = description
            xlSheet.Cells(2, 4).Value = dateStr
 
            ' Chemin de sauvegarde
            savePath = "C:\Rapports\Machines\" & fileName
            xlBook.SaveAs savePath
            xlBook.Close False
            xlApp.Quit
 
            ' Libération mémoire
            Set xlSheet = Nothing
            Set xlBook = Nothing
            Set xlApp = Nothing
        End If
    Next entryID
End Sub