Boostez vos compétences Excel avec notre communauté !
Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !
• | 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 |
Merci pour votre rapidité, mais le fichier contenant les termes "Données clés extraites de la facture" ne se nomme pas en numéro 1.Bonjour,
J'ai eu un peu de retard à l'allumage car il m'a fallu me replonger dans le contexte,
Le code suivant devrait répondre à votre demande :
VB: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, Temp_Folder As Variant, Zip_File As Variant, Zip_Source As Variant, Ligne As Variant, Body As Variant Dim Tampon() As Byte 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 ' on remplace d'abord les vbtab éventuels par par des "retour à la ligne" ' puis les doubles "retour à la ligne" par un seul ' et on éclate le mail en lignes en se basant sur le "retour à la ligne" Body = Replace(Mail.Body, ChrW(&HFFFD), "") ' pour ceux qui envoit mal les accents Body = Replace(Body, vbTab, vbCrLf) Body = Replace(Body, vbCrLf & vbCrLf, vbCrLf) Ligne = Split(Body, vbCrLf) ' Tracer Ligne For L = 0 To UBound(Ligne) Ligne(L) = Trim(Ligne(L)) If L < UBound(Ligne) Then Ligne(L + 1) = Trim(Ligne(L + 1)) Select Case True Case Ligne(L) Like "N°*": Requis = Requis + 1 Facture = Replace(Ligne(L + 1), "/", "_") Debug.Print , "Facture trouvée ( " & Facture & ") " Case Ligne(L) Like "*.zip *": Requis = Requis + 1 Z = Split(Ligne(L), "<") Zip_File = Trim(Z(0)) Zip_Source = Trim(Replace(Z(1), ">", "")) Debug.Print , "Fichier Zip trouvé ( " & Zip_File & " <= " & Zip_Source & " )" Case Ligne(L) Like "*émission de la facture*": W = Split(Ligne(L + 1), "-") If UBound(W) < 2 Then MsgBox "Date de facture incorrecte : " & Ligne(L + 1) & vbLf & "Abandon ....", vbCritical Else Mois = W(1) An = W(2) Debug.Print , "Mois et An trouvés ( " & Mois & "/" & An & " )" Requis = Requis + 1 End If Case Ligne(L) = "Émetteur :": Requis = Requis + 1 fournisseur = Ligne(L + 1) Debug.Print , "Fournisseur trouvé (" & fournisseur & ")" Case Requis = 4 Debug.Print " Tous les requis sont acquis , traitement lancé" ' Construction de l'arborescence de stockage du mail s'il le faut Debug.Print , "Construction de l'arborescence outlook" Set Folder = Set_Outlook_Folder(GetNamespace("Mapi").folders(Mail.ReceivedByName), _ An & "\Fournisseurs\" & Mois & "." & An & "\" & fournisseur) Mail.UnRead = False ' Déplacement ou non du Mail If Move_Mail Then Debug.Print , "Archivage du mail dans " & Folder.FolderPath Set Mail = Mail.Move(Folder) End If ' Enregistrement du fichier Zip Target_Folder = Set_WinDows_Folder( _ Disque_Local & ":\Administration\FOURNISSEURS\Fournisseurs " & An & "\Zip-UNZIP\test") With CreateObject("Scripting.FileSystemObject") Temp_Folder = .GetSpecialFolder(2) & "\ZipOutlook" Debug.Print , "Temp= " & Temp_Folder If .folderexists(Temp_Folder) Then .deletefolder (Temp_Folder) .createFolder (Temp_Folder) End With Zip_File = Temp_Folder & "\" & Zip_File Debug.Print , "Stockage du zip dans " & Temp_Folder With CreateObject("WinHttp.WinHttpRequest.5.1") .Open "Get", Zip_Source, False .Send If .Status = 200 Then Tampon = .responseBody Fic = FreeFile Open Zip_File For Binary Access Write As #Fic Put #Fic, , Tampon Close #Fic Erase Tampon ' dé-Zippage Debug.Print , "Dézippage du zip dans " & Temp_Folder With CreateObject("Shell.Application") ' option 16 pour tout remplacer sans poser de question .NameSpace(Temp_Folder).CopyHere .NameSpace(Zip_File).Items, 16 End With Debug.Print , "Suppression du fichier Zip" Kill Zip_File Debug.Print , , "Renommage des fichiers dézippés" L = 1 Dim LFiles As Variant, Nname As String, Ext As String ' les Xml seront en fin de liste de fichiers LFiles = "" For Each File In CreateObject("Scripting.FileSystemObject").GetFolder(Temp_Folder).Files If InStrRev(File.Name, ".") = 0 Then File.Name = File.Name & ".pdf" Ext = Mid(File.Name, InStrRev(File.Name, ".")) Select Case True Case LFiles = "": LFiles = File.Name Case Ext = ".xml": LFiles = LFiles & "|" & File.Name Case File.Name Like "*Données clés extraites*": First_Name = File.Name Case Else: LFiles = File.Name & "|" & LFiles End Select Next If First_Name <> "" Then If Not InStr(LFiles, First_Name) Then LFiles = First_Name & "|" & LFiles For Each File In Split(LFiles, "|") Ext = Mid(File, InStrRev(File, ".")) Nname = Target_Folder & fournisseur & " " & Facture & "_" & L & Ext If Dir(Nname) <> "" Then Kill Nname Select Case Ext Case ".pdf" Name Temp_Folder & "\" & File As Nname Debug.Print , , File & " ==> " & Nname L = L + 1 Case Else Kill Temp_Folder & "\" & File Debug.Print , , File & " !!! supprimé" End Select Next Debug.Print , "suppression de " & Temp_Folder RmDir Temp_Folder Else MsgBox "Fichier Zip non trouvé sur le serveur" & vbLf & "Abandon ....", vbCritical End If End With Exit For End Select Next Debug.Print , "Fin de Traitement" Debug.Print End Select End Sub
Ce nom de fichier est une partie du nom danbs un fichier au moment du dézippage.Merci pour votre rapidité, mais le fichier contenant les termes "Données clés extraites de la facture" ne se nomme pas en numéro 1.
Ce n'est pas si grave. Ne perdez pas votre temps. 😉
Je ne comprend pas, cela fonctionne comme attendu chez moi : Il faut dire que je travaille toujours sur le message que vous m'aviez envoyé en décembre 2024 Pourriez-vous transmettre le Mail posant problème vers test.vba.fanch55@free.fr ? |
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, Temp_Folder As Variant, Zip_File As Variant, Zip_Source As Variant, Ligne As Variant, Body As Variant
Dim Tampon() As Byte
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
' on remplace d'abord les vbtab éventuels par par des "retour à la ligne"
' puis les doubles "retour à la ligne" par un seul
' et on éclate le mail en lignes en se basant sur le "retour à la ligne"
Body = Replace(Mail.Body, ChrW(&HFFFD), "") ' pour ceux qui envoient mal les accents
Body = Replace(Body, vbTab, vbCrLf)
Body = Replace(Body, vbCrLf & vbCrLf, vbCrLf)
Ligne = Split(Body, vbCrLf)
' Tracer Ligne
For L = 0 To UBound(Ligne)
Ligne(L) = Trim(Ligne(L))
If L < UBound(Ligne) Then Ligne(L + 1) = Trim(Ligne(L + 1))
Select Case True
Case Ligne(L) Like "N°*": Requis = Requis + 1
Facture = Replace(Ligne(L + 1), "/", "_")
Debug.Print , "Facture trouvée ( " & Facture & ") "
Case Ligne(L) Like "*.zip *": Requis = Requis + 1
Z = Split(Ligne(L), "<")
Zip_File = Trim(Z(0))
Zip_Source = Trim(Replace(Z(1), ">", ""))
Debug.Print , "Fichier Zip trouvé ( " & Zip_File & " <= " & Zip_Source & " )"
Case Ligne(L) Like "*émission de la facture*":
W = Split(Ligne(L + 1), "-")
If UBound(W) < 2 Then
MsgBox "Date de facture incorrecte : " & Ligne(L + 1) & vbLf & "Abandon ....", vbCritical
Else
Mois = W(1)
An = W(2)
Debug.Print , "Mois et An trouvés ( " & Mois & "/" & An & " )"
Requis = Requis + 1
End If
Case Ligne(L) = "Émetteur :": Requis = Requis + 1
fournisseur = Ligne(L + 1)
Debug.Print , "Fournisseur trouvé (" & fournisseur & ")"
Case Requis = 4
Debug.Print " Tous les requis sont acquis , traitement lancé"
' Construction de l'arborescence de stockage du mail s'il le faut
Debug.Print , "Construction de l'arborescence outlook"
Set Folder = Set_Outlook_Folder(GetNamespace("Mapi").folders(Mail.ReceivedByName), _
An & "\Fournisseurs\" & Mois & "." & An & "\" & fournisseur)
Mail.UnRead = False
' Déplacement ou non du Mail
If Move_Mail Then
Debug.Print , "Archivage du mail dans " & Folder.FolderPath
Set Mail = Mail.Move(Folder)
End If
' Enregistrement du fichier Zip
Target_Folder = Set_WinDows_Folder( _
Disque_Local & ":\Administration\FOURNISSEURS\Fournisseurs " & An & "\Zip-UNZIP\test")
With CreateObject("Scripting.FileSystemObject")
Temp_Folder = .GetSpecialFolder(2) & "\ZipOutlook"
Debug.Print , "Temp= " & Temp_Folder
If .folderexists(Temp_Folder) Then .deletefolder (Temp_Folder)
.createFolder (Temp_Folder)
End With
Zip_File = Temp_Folder & "\" & Zip_File
Debug.Print , "Stockage du zip dans " & Temp_Folder
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "Get", Zip_Source, False
.Send
If .Status = 200 Then
Tampon = .responseBody
Fic = FreeFile
Open Zip_File For Binary Access Write As #Fic
Put #Fic, , Tampon
Close #Fic
Erase Tampon
' dé-Zippage
Debug.Print , "Dézippage du zip dans " & Temp_Folder
With CreateObject("Shell.Application")
' option 16 pour tout remplacer sans poser de question
.NameSpace(Temp_Folder).CopyHere .NameSpace(Zip_File).Items, 16
End With
Debug.Print , "Suppression du fichier Zip"
Kill Zip_File
Debug.Print , , "Renommage des fichiers dézippés"
L = 1
Dim LFiles As Variant, Nname As String, Ext As String
' les Xml seront en fin de liste de fichiers
LFiles = ""
For Each File In CreateObject("Scripting.FileSystemObject").GetFolder(Temp_Folder).Files
If InStrRev(File.Name, ".") = 0 Then File.Name = File.Name & ".pdf"
Ext = Mid(File.Name, InStrRev(File.Name, "."))
Select Case True
Case File.Name Like "*Données clés extraites*":
First_Name = File.Name
Case LFiles = "": LFiles = File.Name
Case Ext = ".xml": LFiles = LFiles & "|" & File.Name
Case Else: LFiles = File.Name & "|" & LFiles
End Select
Next
If First_Name <> "" Then LFiles = First_Name & "|" & LFiles
For Each File In Split(LFiles, "|")
Ext = Mid(File, InStrRev(File, "."))
Nname = Target_Folder & fournisseur & " " & Facture & "_" & L & Ext
If Dir(Nname) <> "" Then Kill Nname
Select Case Ext
Case ".pdf"
Name Temp_Folder & "\" & File As Nname
Debug.Print , , File & " ==> " & Nname
L = L + 1
Case Else
Kill Temp_Folder & "\" & File
Debug.Print , , File & " !!! supprimé"
End Select
Next
Debug.Print , "suppression de " & Temp_Folder
RmDir Temp_Folder
Else
MsgBox "Fichier Zip non trouvé sur le serveur" & vbLf & "Abandon ....", vbCritical
End If
End With
Exit For
End Select
Next
Debug.Print , "Fin de Traitement"
Debug.Print
End Select
End Sub
Parfait. Encore un grand merci et bon dimanche. Bien à vous,Ok, renommage normalement résolu :
VB: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, Temp_Folder As Variant, Zip_File As Variant, Zip_Source As Variant, Ligne As Variant, Body As Variant Dim Tampon() As Byte 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 ' on remplace d'abord les vbtab éventuels par par des "retour à la ligne" ' puis les doubles "retour à la ligne" par un seul ' et on éclate le mail en lignes en se basant sur le "retour à la ligne" Body = Replace(Mail.Body, ChrW(&HFFFD), "") ' pour ceux qui envoient mal les accents Body = Replace(Body, vbTab, vbCrLf) Body = Replace(Body, vbCrLf & vbCrLf, vbCrLf) Ligne = Split(Body, vbCrLf) ' Tracer Ligne For L = 0 To UBound(Ligne) Ligne(L) = Trim(Ligne(L)) If L < UBound(Ligne) Then Ligne(L + 1) = Trim(Ligne(L + 1)) Select Case True Case Ligne(L) Like "N°*": Requis = Requis + 1 Facture = Replace(Ligne(L + 1), "/", "_") Debug.Print , "Facture trouvée ( " & Facture & ") " Case Ligne(L) Like "*.zip *": Requis = Requis + 1 Z = Split(Ligne(L), "<") Zip_File = Trim(Z(0)) Zip_Source = Trim(Replace(Z(1), ">", "")) Debug.Print , "Fichier Zip trouvé ( " & Zip_File & " <= " & Zip_Source & " )" Case Ligne(L) Like "*émission de la facture*": W = Split(Ligne(L + 1), "-") If UBound(W) < 2 Then MsgBox "Date de facture incorrecte : " & Ligne(L + 1) & vbLf & "Abandon ....", vbCritical Else Mois = W(1) An = W(2) Debug.Print , "Mois et An trouvés ( " & Mois & "/" & An & " )" Requis = Requis + 1 End If Case Ligne(L) = "Émetteur :": Requis = Requis + 1 fournisseur = Ligne(L + 1) Debug.Print , "Fournisseur trouvé (" & fournisseur & ")" Case Requis = 4 Debug.Print " Tous les requis sont acquis , traitement lancé" ' Construction de l'arborescence de stockage du mail s'il le faut Debug.Print , "Construction de l'arborescence outlook" Set Folder = Set_Outlook_Folder(GetNamespace("Mapi").folders(Mail.ReceivedByName), _ An & "\Fournisseurs\" & Mois & "." & An & "\" & fournisseur) Mail.UnRead = False ' Déplacement ou non du Mail If Move_Mail Then Debug.Print , "Archivage du mail dans " & Folder.FolderPath Set Mail = Mail.Move(Folder) End If ' Enregistrement du fichier Zip Target_Folder = Set_WinDows_Folder( _ Disque_Local & ":\Administration\FOURNISSEURS\Fournisseurs " & An & "\Zip-UNZIP\test") With CreateObject("Scripting.FileSystemObject") Temp_Folder = .GetSpecialFolder(2) & "\ZipOutlook" Debug.Print , "Temp= " & Temp_Folder If .folderexists(Temp_Folder) Then .deletefolder (Temp_Folder) .createFolder (Temp_Folder) End With Zip_File = Temp_Folder & "\" & Zip_File Debug.Print , "Stockage du zip dans " & Temp_Folder With CreateObject("WinHttp.WinHttpRequest.5.1") .Open "Get", Zip_Source, False .Send If .Status = 200 Then Tampon = .responseBody Fic = FreeFile Open Zip_File For Binary Access Write As #Fic Put #Fic, , Tampon Close #Fic Erase Tampon ' dé-Zippage Debug.Print , "Dézippage du zip dans " & Temp_Folder With CreateObject("Shell.Application") ' option 16 pour tout remplacer sans poser de question .NameSpace(Temp_Folder).CopyHere .NameSpace(Zip_File).Items, 16 End With Debug.Print , "Suppression du fichier Zip" Kill Zip_File Debug.Print , , "Renommage des fichiers dézippés" L = 1 Dim LFiles As Variant, Nname As String, Ext As String ' les Xml seront en fin de liste de fichiers LFiles = "" For Each File In CreateObject("Scripting.FileSystemObject").GetFolder(Temp_Folder).Files If InStrRev(File.Name, ".") = 0 Then File.Name = File.Name & ".pdf" Ext = Mid(File.Name, InStrRev(File.Name, ".")) Select Case True Case File.Name Like "*Données clés extraites*": First_Name = File.Name Case LFiles = "": LFiles = File.Name Case Ext = ".xml": LFiles = LFiles & "|" & File.Name Case Else: LFiles = File.Name & "|" & LFiles End Select Next If First_Name <> "" Then LFiles = First_Name & "|" & LFiles For Each File In Split(LFiles, "|") Ext = Mid(File, InStrRev(File, ".")) Nname = Target_Folder & fournisseur & " " & Facture & "_" & L & Ext If Dir(Nname) <> "" Then Kill Nname Select Case Ext Case ".pdf" Name Temp_Folder & "\" & File As Nname Debug.Print , , File & " ==> " & Nname L = L + 1 Case Else Kill Temp_Folder & "\" & File Debug.Print , , File & " !!! supprimé" End Select Next Debug.Print , "suppression de " & Temp_Folder RmDir Temp_Folder Else MsgBox "Fichier Zip non trouvé sur le serveur" & vbLf & "Abandon ....", vbCritical End If End With Exit For End Select Next Debug.Print , "Fin de Traitement" Debug.Print End Select End Sub
Bonjour Fanch, voilà l'exemple avec un fichier sans extension. Lorqu'il est renommé, il est en .PDF et lorsque je lance votre autre macro d'impression PDF, les fichiers avec extension en majuscule de sont pas pris en compte. Lorque je change la casse, tout fonctionne. 😉Bonsoir, pouvez-vous me fournir un message exemple ?
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, Temp_Folder As Variant, Zip_File As Variant, Zip_Source As Variant, Ligne As Variant, Body As Variant
Dim Tampon() As Byte
Dim Flag As Integer
Dim L As Integer, Requis As Integer
If Mail.FlagRequest = "" Then Flag = 2 Else Flag = DateDiff("n", Mail.FlagRequest, Now)
Select Case True
Case Flag < 2 ' on laisse un écart de 2 minutes
MsgBox "Le traitement a déja été lancé le" & vbLf _
& Replace(Mail.FlagRequest, " ", " à "), vbCritical, "Mail déjà reservé"
Case Not Mail.ReceivedByName = Destinataire
Case Not Mail.SenderEmailAddress = Emetteur
Case Else
Mail.FlagRequest = Now
Debug.Print "Incoming " & Mail.Subject _
& " from " & Mail.SenderEmailAddress _
& " to " & Mail.ReceivedByName
' on remplace d'abord les vbtab éventuels par par des "retour à la ligne"
' puis les doubles "retour à la ligne" par un seul
' et on éclate le mail en lignes en se basant sur le "retour à la ligne"
Body = Replace(Mail.Body, ChrW(&HFFFD), "") ' pour ceux qui envoient mal les accents
Body = Replace(Body, vbTab, vbCrLf)
Body = Replace(Body, vbCrLf & vbCrLf, vbCrLf)
Ligne = Split(Body, vbCrLf)
' Tracer Ligne
For L = 0 To UBound(Ligne)
Ligne(L) = Trim(Ligne(L))
If L < UBound(Ligne) Then Ligne(L + 1) = Trim(Ligne(L + 1))
Select Case True
Case Ligne(L) Like "N°*": Requis = Requis + 1
Facture = Replace(Ligne(L + 1), "/", "_")
Debug.Print , "Facture trouvée ( " & Facture & ") "
Case Ligne(L) Like "*.zip *": Requis = Requis + 1
Z = Split(Ligne(L), "<")
Zip_File = Trim(Z(0))
Zip_Source = Trim(Replace(Z(1), ">", ""))
Debug.Print , "Fichier Zip trouvé ( " & Zip_File & " <= " & Zip_Source & " )"
Case Ligne(L) Like "*émission de la facture*":
W = Split(Ligne(L + 1), "-")
If UBound(W) < 2 Then
MsgBox "Date de facture incorrecte : " & Ligne(L + 1) & vbLf & "Abandon ....", vbCritical
Else
Mois = W(1)
An = W(2)
Debug.Print , "Mois et An trouvés ( " & Mois & "/" & An & " )"
Requis = Requis + 1
End If
Case Ligne(L) = "Émetteur :": Requis = Requis + 1
fournisseur = Ligne(L + 1)
Debug.Print , "Fournisseur trouvé (" & fournisseur & ")"
Case Requis = 4
Debug.Print " Tous les requis sont acquis , traitement lancé"
' Construction de l'arborescence de stockage du mail s'il le faut
Debug.Print , "Construction de l'arborescence outlook"
Set Folder = Set_Outlook_Folder(GetNamespace("Mapi").folders(Mail.ReceivedByName), _
An & "\Fournisseurs\" & Mois & "." & An & "\" & fournisseur)
Mail.UnRead = False
' Déplacement ou non du Mail
If Move_Mail Then
Debug.Print , "Archivage du mail dans " & Folder.FolderPath
Set Mail = Mail.Move(Folder)
End If
' Enregistrement du fichier Zip
Target_Folder = Set_WinDows_Folder( _
Disque_Local & ":\Administration\FOURNISSEURS\Fournisseurs " & An & "\Zip-UNZIP\test")
With CreateObject("Scripting.FileSystemObject")
Temp_Folder = .GetSpecialFolder(2) & "\ZipOutlook"
Debug.Print , "Temp= " & Temp_Folder
If .folderexists(Temp_Folder) Then .deletefolder (Temp_Folder)
.createFolder (Temp_Folder)
End With
Zip_File = Temp_Folder & "\" & Zip_File
Debug.Print , "Stockage du zip dans " & Temp_Folder
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "Get", Zip_Source, False
.Send
If .Status = 200 Then
Tampon = .responseBody
Fic = FreeFile
Open Zip_File For Binary Access Write As #Fic
Put #Fic, , Tampon
Close #Fic
Erase Tampon
' dé-Zippage
Debug.Print , "Dézippage du zip dans " & Temp_Folder
With CreateObject("Shell.Application")
' option 16 pour tout remplacer sans poser de question
.NameSpace(Temp_Folder).CopyHere .NameSpace(Zip_File).Items, 16
End With
Debug.Print , "Suppression du fichier Zip"
Kill Zip_File
Debug.Print , , "Renommage des fichiers dézippés"
L = 1
Dim LFiles As Variant, Nname As String, Ext As String
' les Xml seront en fin de liste de fichiers
LFiles = ""
For Each File In CreateObject("Scripting.FileSystemObject").GetFolder(Temp_Folder).Files
If InStrRev(File.Name, ".") = 0 Then File.Name = File.Name & ".pdf"
Ext = Mid(File.Name, InStrRev(File.Name, "."))
Select Case True
Case File.Name Like "*Données clés extraites*":
First_Name = File.Name
Case LFiles = "": LFiles = File.Name
Case Ext = ".xml": LFiles = LFiles & "|" & File.Name
Case Else: LFiles = File.Name & "|" & LFiles
End Select
Next
If First_Name <> "" Then LFiles = First_Name & "|" & LFiles
For Each File In Split(LFiles, "|")
Ext = LCase(Mid(File, InStrRev(File, ".")))
Nname = Target_Folder & fournisseur & " " & Facture & "_" & L & Ext
If Dir(Nname) <> "" Then Kill Nname
Select Case Ext
Case ".pdf"
Name Temp_Folder & "\" & File As Nname
Debug.Print , , File & " ==> " & Nname
L = L + 1
Case Else
Kill Temp_Folder & "\" & File
Debug.Print , , File & " !!! supprimé"
End Select
Next
Debug.Print , "suppression de " & Temp_Folder
RmDir Temp_Folder
Else
MsgBox "Fichier Zip non trouvé sur le serveur" & vbLf & "Abandon ....", vbCritical
End If
End With
Exit For
End Select
Next
Mail.ClearTaskFlag
Debug.Print , "Fin de Traitement"
Debug.Print
End Select
End Sub
We use cookies and similar technologies for the following purposes:
Est ce que vous acceptez les cookies et ces technologies?
We use cookies and similar technologies for the following purposes:
Est ce que vous acceptez les cookies et ces technologies?