• | 20241204_facture électronique_20241086.zip |
• | N°/Identifiant de la facture : | 20241086 |
• | Émetteur : | Fournisseur XX |
• | Identifiant Peppol de l’émetteur : | 123456 |
• | Date d’émission de la facture : | 04-12-2024 |
• | Date de réception effective : | 04-12-2024 |
• | Destinataire : | Client ZZ |
• | Identifiant Peppol du destinataire : | LU456789 |
• | Montant total TTC : | 100.00 EUR |
Dans le volet gauche, dans le module ThisOutlookSession : | entrez le code ci-dessous :
VB:
Ce code sera exécuté pour chaque mail arrivant dans la boite de réception. |
Insérez un nouveau module | Entrez-y le code ci-dessous : ( vérifiez auparavant ce qui concerne l'émetteur et le destinataire ainsi que le Target_Path et le Target_Folder qui me semblent incomplets coté dézippage )
VB:
|
Option Compare Text
Sub Exec_Manuel()
' pour lancer le script manuellement,
' le mail doit être dans le dossier réception et affiché
Script_Delatte ActiveInspector.CurrentItem
End Sub
Sub Script_Delatte(Mail As Outlook.MailItem)
Dim Folder As MAPIFolder
Dim An As String, Mois As String, Facture As String
Dim Target_Folder As Variant, Zip_File As Variant, Line As Variant
Dim L As Integer, Requis As Integer
Const Emetteur = "info@efact.public.lu"
Const Destinataire = "accounting@societe.lu"
Select Case True
Case Not Mail.ReceivedByName = Destinataire
Case Not Mail.SenderEmailAddress = Emetteur
Case Else
Debug.Print "Incoming " & Mail.Subject _
& " from " & Mail.SenderEmailAddress _
& " to " & Mail.ReceivedByName
Line = Split(Mail.Body, vbCrLf & vbCrLf)
For L = 0 To UBound(Line)
Select Case True
Case Trim(Line(L)) Like "N°*": Requis = Requis + 1
Facture = Trim(Line(L + 1))
Case Trim(Line(L)) Like "*émission de la facture*": Requis = Requis + 1
W = Split(Trim(Line(L + 1)), "-")
Mois = W(1)
An = W(2)
Case Trim(Line(L)) = "Émetteur :": Requis = Requis + 1
Fournisseur = Trim(Line(L + 1))
Case Requis = 3
' Construction de l'arborescence s'il le faut
Set Folder = Set_Outlook_Folder(GetNamespace("Mapi").Folders(Mail.ReceivedByName), "Accounting\" & An & "\Fournisseurs\" & Mois & "." & An & "\" & Fournisseur)
Mail.UnRead = False
' -------------------------------------------------------------------------------------------------
' Décommenter la ligne suivante pour déplacer réellement le mail
Set Mail = Mail.Move(Folder)
' -------------------------------------------------------------------------------------------------
With Mail.Attachments.Item(1) ' Fichier joint
' enregistrement du fichier Zip
Target_Folder = Set_WinDows_Folder("S:\Administration\FOURNISSEURS\Fournisseurs " & An & "\Zip-UNZIP\test\" & Fournisseur & "\" & Facture)
Zip_File = Target_Folder & .FileName
.SaveAsFile Zip_File
' dé-Zippage
With CreateObject("Shell.Application")
' option 16 pour tout remplacer sans poser de question
.NameSpace(Target_Folder).CopyHere .NameSpace(Zip_File).Items, 16
End With
Kill Zip_File
End With
Exit For
End Select
Next
End Select
End Sub
Function Set_Outlook_Folder(Mapi As MAPIFolder, Target_Folder As Variant) As MAPIFolder
Dim Folder As MAPIFolder
On Error Resume Next
For Each N In Split(Target_Folder, "\")
Set Folder = Mapi.Folders(N)
If Folder Is Nothing Then Set Folder = Mapi.Folders.Add(N)
Set Mapi = Folder
Set Folder = Nothing
Next
On Error GoTo 0
Set Set_Outlook_Folder = Mapi
End Function
Function Set_WinDows_Folder(Target_Folder)
Dim Folder
For Each F In Split(Target_Folder, "\")
Folder = IIf(Folder = "", "", Folder) & F & "\"
If Dir(Folder, vbDirectory) = "" Then MkDir Folder
Next
Set_WinDows_Folder = Folder
End Function
Pas de problème avec des boites multiples dans Outlook, moi-même, j'en ai 5 .Je viens d'essayer ceci mais rien ne se passe. A savoir que j'ai deux boîtes de réception dans Outlook.
Option Compare Text
Const Emetteur = "info@efact.public.lu"
Const Destinataire = "accounting@societe.lu"
Sub Exec_Manuel() ' Lancement manuel à partir de la boite de réception
Dim Bal As Items, Mail As MailItem
Set Bal = GetNamespace("Mapi").folders(Destinataire).folders("Boîte de réception").Items
Set Mail = Bal.Find("[SenderEmailAddress]=""" & Emetteur & """")
If Not Mail Is Nothing Then Script_Delatte Mail
End Sub
Sub Script_Delatte(Mail As MailItem)
Dim Folder As MAPIFolder
Dim An As String, Mois As String, Facture As String
Dim Target_Folder As Variant, Zip_File As Variant, Line As Variant
Dim L As Integer, Requis As Integer
Select Case True
Case Not Mail.ReceivedByName = Destinataire
Case Not Mail.SenderEmailAddress = Emetteur
Case Else
Debug.Print "Incoming " & Mail.Subject _
& " from " & Mail.SenderEmailAddress _
& " to " & Mail.ReceivedByName
Line = Split(Mail.Body, vbCrLf & vbCrLf)
For L = 0 To UBound(Line)
Select Case True
Case Trim(Line(L)) Like "N°*": Requis = Requis + 1
Facture = Trim(Line(L + 1))
Case Trim(Line(L)) Like "*émission de la facture*": Requis = Requis + 1
W = Split(Trim(Line(L + 1)), "-")
Mois = W(1)
An = W(2)
Case Trim(Line(L)) = "Émetteur :": Requis = Requis + 1
Fournisseur = Trim(Line(L + 1))
Case Requis = 3
' Construction de l'arborescence s'il le faut
Set Folder = Set_Outlook_Folder(GetNamespace("Mapi").folders(Mail.ReceivedByName), "Accounting\" & An & "\Fournisseurs\" & Mois & "." & An & "\" & Fournisseur)
Mail.UnRead = False
' -------------------------------------------------------------------------------------------------
' Décommenter la ligne suivante pour déplacer réellement le mail
Set Mail = Mail.Move(Folder)
' -------------------------------------------------------------------------------------------------
With Mail.Attachments.Item(1) ' Fichier joint
' enregistrement du fichier Zip
Target_Folder = Set_WinDows_Folder("S:\Administration\FOURNISSEURS\Fournisseurs " & An & "\Zip-UNZIP\test\" & Fournisseur & "\" & Facture)
Zip_File = Target_Folder & .FileName
.SaveAsFile Zip_File
' dé-Zippage
With CreateObject("Shell.Application")
' option 16 pour tout remplacer sans poser de question
.NameSpace(Target_Folder).CopyHere .NameSpace(Zip_File).Items, 16
End With
Kill Zip_File
End With
Exit For
End Select
Next
End Select
End Sub
Function Set_Outlook_Folder(Mapi As MAPIFolder, Target_Folder As Variant) As MAPIFolder
Dim Folder As MAPIFolder
On Error Resume Next
For Each N In Split(Target_Folder, "\")
Set Folder = Mapi.folders(N)
If Folder Is Nothing Then Set Folder = Mapi.folders.Add(N)
Set Mapi = Folder
Set Folder = Nothing
Next
On Error GoTo 0
Set Set_Outlook_Folder = Mapi
End Function
Function Set_WinDows_Folder(Target_Folder)
Dim Folder
For Each F In Split(Target_Folder, "\")
Folder = IIf(Folder = "", "", Folder) & F & "\"
If Dir(Folder, vbDirectory) = "" Then MkDir Folder
Next
Set_WinDows_Folder = Folder
End Function
Dossier Window : | Dossier Outlook : |
---|---|
Option Compare Text
Const Emetteur = "info@efact.public.lu"
Const Destinataire = "accounting@societe.lu"
Sub Exec_Manuel() ' Lancement manuel à partir de la boite de réception
Dim Bal As Outlook.Items, Mail As Outlook.MailItem
On Error Resume Next
Set Bal = GetNamespace("Mapi").Stores(Destinataire).GetDefaultFolder(olFolderInbox).Items
If Bal Is Nothing Then
MsgBox "Le destinataire " & Destinataire & vbLf _
& " n'existe probablement pas ...." & vbLf & vbLf _
& Err.Number & vbLf _
& Err.Description, vbCritical
Else
On Error GoTo 0
Set Mail = Bal.Find("[SenderEmailAddress]=""" & Emetteur & """")
If Not Mail Is Nothing Then Script_Delatte Mail
End If
End Sub
Sub Script_Delatte(Mail As Outlook.MailItem)
Dim Folder As Outlook.MAPIFolder
Dim An As String, Mois As String, Facture As String
Dim Target_Folder As Variant, Zip_File As Variant, Line As Variant
Dim L As Integer, Requis As Integer
Select Case True
Case Not Mail.ReceivedByName = Destinataire
Case Not Mail.SenderEmailAddress = Emetteur
Case Else
Debug.Print "Incoming " & Mail.Subject _
& " from " & Mail.SenderEmailAddress _
& " to " & Mail.ReceivedByName
Line = Split(Mail.Body, vbCrLf & vbCrLf)
For L = 0 To UBound(Line)
Select Case True
Case Trim(Line(L)) Like "N°*": Requis = Requis + 1
Facture = Trim(Line(L + 1))
Case Trim(Line(L)) Like "*émission de la facture*": Requis = Requis + 1
W = Split(Trim(Line(L + 1)), "-")
Mois = W(1)
An = W(2)
Case Trim(Line(L)) = "Émetteur :": Requis = Requis + 1
Fournisseur = Trim(Line(L + 1))
Case Requis = 3
' Construction de l'arborescence s'il le faut
Set Folder = Set_Outlook_Folder(GetNamespace("Mapi").folders(Mail.ReceivedByName), _
"Accounting\" & An & "\Fournisseurs\" & Mois & "." & An & "\" & Fournisseur)
Mail.UnRead = False
' -------------------------------------------------------------------------------------------------
' Décommenter la ligne suivante pour déplacer réellement le mail
Set Mail = Mail.Move(Folder)
' -------------------------------------------------------------------------------------------------
With Mail.Attachments.Item(1) ' Fichier joint
' enregistrement du fichier Zip
Target_Folder = Set_WinDows_Folder( _
"S:\Administration\FOURNISSEURS\Fournisseurs " & An & "\Zip-UNZIP\test\" & Fournisseur & "\" & Facture)
Zip_File = Target_Folder & .FileName
.SaveAsFile Zip_File
' dé-Zippage
With CreateObject("Shell.Application")
' option 16 pour tout remplacer sans poser de question
.NameSpace(Target_Folder).CopyHere .NameSpace(Zip_File).Items, 16
End With
Kill Zip_File
End With
Exit For
End Select
Next
End Select
End Sub
Function Set_Outlook_Folder(Mapi As Outlook.MAPIFolder, Target_Folder As Variant) As Outlook.MAPIFolder
Dim Folder As Outlook.MAPIFolder
On Error Resume Next
For Each N In Split(Target_Folder, "\")
Set Folder = Mapi.folders(N)
If Folder Is Nothing Then Set Folder = Mapi.folders.Add(N)
Set Mapi = Folder
Set Folder = Nothing
Next
On Error GoTo 0
Set Set_Outlook_Folder = Mapi
End Function
Function Set_WinDows_Folder(Target_Folder)
Dim Folder
For Each F In Split(Target_Folder, "\")
Folder = IIf(Folder = "", "", Folder) & F & "\"
If Dir(Folder, vbDirectory) = "" Then MkDir Folder
Next
Set_WinDows_Folder = Folder
End Function
• | 20241204_facture électronique_20241086.zip |
• | N°/Identifiant de la facture : | 20241086 |
• | Émetteur : | Fournisseur XX |
• | Identifiant Peppol de l’émetteur : | 123456 |
• | Date d’émission de la facture : | 04-12-2024 |
• | Date de réception effective : | 04-12-2024 |
• | Destinataire : | Client ZZ |
• | Identifiant Peppol du destinataire : | LU456789 |
• | Montant total TTC : | 100.00 EUR |
Je suis parti du principe que le Zip était un lien ( fichier externe), mais si cela ne fonctionne pas, fournissez-moi une copie de ce qui est dans votre lien . |
Option Compare Text
Const Emetteur = "info@efact.public.lu"
Const Destinataire = "accounting"
Sub Exec_Manuel() ' Lancement manuel à partir de la boite de réception
Dim Bal As Outlook.Items, Mail As Outlook.MailItem
On Error Resume Next
Set Bal = GetNamespace("Mapi").Stores(Destinataire).GetDefaultFolder(olFolderInbox).Items
If Bal Is Nothing Then
MsgBox "Le destinataire " & Destinataire & vbLf _
& " n'existe probablement pas ...." & vbLf & vbLf _
& Err.Number & vbLf _
& Err.Description, vbCritical
Else
On Error GoTo 0
Set Mail = Bal.Find("[SenderEmailAddress]=""" & Emetteur & """")
If Not Mail Is Nothing Then Script_Delatte Mail
End If
End Sub
Sub Script_Delatte(Mail As Outlook.MailItem)
Dim Folder As Outlook.MAPIFolder
Dim An As String, Mois As String, Facture As String
Dim Target_Folder As Variant, Zip_File As Variant, Zip_Source As Variant, Line As Variant
Dim L As Integer, Requis As Integer
Select Case True
Case Not Mail.ReceivedByName = Destinataire
Case Not Mail.SenderEmailAddress = Emetteur
Case Else
Debug.Print "Incoming " & Mail.Subject _
& " from " & Mail.SenderEmailAddress _
& " to " & Mail.ReceivedByName
Line = Split(Mail.Body, vbCrLf & vbCrLf)
For L = 0 To UBound(Line)
Select Case True
Case Trim(Line(L)) Like "N°*": Requis = Requis + 1
Facture = Trim(Line(L + 1))
Debug.Print , "Facture trouvée ( " & Facture & ") "
Case Trim(Line(L)) Like "*.zip *": Requis = Requis + 1
Z = Split(Line(L), "<")
Zip_File = Trim(Z(0))
Zip_Source = Trim(Replace(Split(Z(1), ":")(1), ">", ""))
Zip_Source = Replace(Zip_Source, "/", "\")
Debug.Print , "Fichier Zip trouvé ( " & Zip_File & " <= " & Zip_Source & " )"
Case Trim(Line(L)) Like "*émission de la facture*": Requis = Requis + 1
W = Split(Trim(Line(L + 1)), "-")
Mois = W(1)
An = W(2)
Debug.Print , "Mois et An trouvés ( " & Mois & "/" & An & " )"
Case Trim(Line(L)) = "Émetteur :": Requis = Requis + 1
Fournisseur = Trim(Line(L + 1))
Debug.Print , "Fournisseur trouvé (" & Fournisseur & ")"
Case Requis = 4
Debug.Print " Tous les requis sont acquis"
Debug.Print , "Construction de l'arborescence outlook"
' Construction de l'arborescence s'il le faut
Set Folder = Set_Outlook_Folder(GetNamespace("Mapi").folders(Mail.ReceivedByName), _
"Accounting\" & An & "\Fournisseurs\" & Mois & "." & An & "\" & Fournisseur)
Mail.UnRead = False
' -------------------------------------------------------------------------------------------------
' Décommenter la ligne suivante pour déplacer réellement le mail
Debug.Print , "Archivage du mail dans " & Folder.FolderPath
Set Mail = Mail.Move(Folder)
' -------------------------------------------------------------------------------------------------
' enregistrement du fichier Zip
Target_Folder = Set_WinDows_Folder( _
"S:\Administration\FOURNISSEURS\Fournisseurs " & An & "\Zip-UNZIP\test\" & Fournisseur & "\" & Facture)
Zip_File = Target_Folder & Zip_File
Debug.Print , "Stockage du zip dans " & Target_Folder
FileCopy Zip_Source, Zip_File
' dé-Zippage
With CreateObject("Shell.Application")
Debug.Print , "Dézippage"
' option 16 pour tout remplacer sans poser de question
.NameSpace(Target_Folder).CopyHere .NameSpace(Zip_File).Items, 16
End With
Debug.Print , "élimination du fichier Zip"
Kill Zip_File
Exit For
End Select
Next
Debug.Print "Fin de Traitement"
End Select
End Sub
Function Set_Outlook_Folder(Mapi As Outlook.MAPIFolder, Target_Folder As Variant) As Outlook.MAPIFolder
Dim Folder As Outlook.MAPIFolder
On Error Resume Next
For Each N In Split(Target_Folder, "\")
Set Folder = Mapi.folders(N)
If Folder Is Nothing Then Set Folder = Mapi.folders.Add(N)
Set Mapi = Folder
Set Folder = Nothing
Next
On Error GoTo 0
Set Set_Outlook_Folder = Mapi
End Function
Function Set_WinDows_Folder(Target_Folder)
Dim Folder
For Each F In Split(Target_Folder, "\")
Folder = IIf(Folder = "", "", Folder) & F & "\"
If Dir(Folder, vbDirectory) = "" Then MkDir Folder
Next
Set_WinDows_Folder = Folder
End Function
Sub Store_mail()
With Mail.Attachments.Item(1) ' Fichier joint
' enregistrement du fichier Zip
Target_Folder = Set_WinDows_Folder( _
"F:\Administration\FOURNISSEURS\Fournisseurs " & An & "\Zip-UNZIP\test\" & Fournisseur & "\" & Facture)
Zip_File = Target_Folder & .FileName
Debug.Print , "stockage du zip dans " & Target_Folder
.SaveAsFile Zip_File
' dé-Zippage
With CreateObject("Shell.Application")
Debug.Print , "dézippage"
' option 16 pour tout remplacer sans poser de question
.NameSpace(Target_Folder).CopyHere .NameSpace(Zip_File).Items, 16
End With
Debug.Print , "élimination du fichier Zip"
Kill Zip_File
End With
End Sub