Microsoft 365 Modification fichiers .xml via macro

Poisss · 1 Août 2023

Bonjour à tous, après plusieurs recherches, je n'ai pas trouvé de solution à mon problème.
Voici le sujet :
Je dois faire une modification de masse sur une centaine de fichiers textes (Nom des fichiers : Blocks.xml, il se trouve chacun dans un dossier que j'ai dézippé auparavant, le répertoire des dossiers dézippés ne contient que ce type de dossier et il faut tous les traiter) de sorte à obtenir :
<Racks>
<Rack>VIS01</Rack>
</Racks>

-->

<Racks>
<Rack>VIS01-01</Rack>
<Rack>VIS01-02</Rack>
<Rack>VIS01-03</Rack>
<Rack>VIS01-04</Rack>
<Rack>VIS01-05</Rack>
<Rack>VIS01-06</Rack>
...
<Rack>VIS01-99</Rack>
</Racks>

Dans certains fichiers, on retrouve seulement une ligne avec VIS01, dans d'autres, il y a une ligne avec VIS01 et une autre en dessous avec VIS02. Il faut alors incrémenter les deux valeurs de -01 à -99 :

<Racks>
<Rack>VIS01</Rack>
<Rack>VIS02</Rack>
</Racks>

-->

<Racks>
<Rack>VIS01-01</Rack>
<Rack>VIS01-02</Rack>
<Rack>VIS01-03</Rack>
<Rack>VIS01-04</Rack>
<Rack>VIS01-05</Rack>
<Rack>VIS01-06</Rack>
...
<Rack>VIS01-99</Rack>

<Rack>VIS02-01</Rack>
<Rack>VIS02-02</Rack>
<Rack>VIS02-03</Rack>
<Rack>VIS02-04</Rack>
<Rack>VIS02-05</Rack>
<Rack>VIS02-06</Rack>
...
<Rack>VIS02-99</Rack>
</Racks>

Je suis preneur d'un code VBA qui pourrait faire une incrémentation des lignes présente dans et pour chaque fichier Blocks.xml

En vous remerciant, bonne journée à vous !

PS : j'ai déjà un code mais il provient de CHATGPT, il fonctionne mais produit de nombreuses erreurs sur l'incrémentation, il n'arrive pas à incrémenter seulement la ou les lignes présentes dans le fichier, il incrémente également les valeurs qu'il a pu croiser dans les fichiers précédents.

Compte Supprimé 979 · 1 Août 2023

Bonjour Poisss,

Si vous avez déjà un code, merci de l'intégrer à votre publication, même s'il ne fonctionne pas correctement

Profitez en pour relire la charte.

A+

patricktoulon · 1 Août 2023

Bonjour

il te faut créer un sous dossier dans le dossier des fichiers
il faut une boucle pour lister les fichier(boucle dir)
il faut créer un Xml Document en memoire(CreateObject("Microsoft.XMLDOM") pour parcourir l'arborescence existante
dans la boucle arborescence boucler de 1 à 99
créer les balises "Rack" sur la base des rack existants
en fin de boucle 1 to 99 supprimer le rack original
enregistrer le fichier xml

soit direct
soit avec ma fonction avec indentation

j'ai fait 2 fichiers en exemple

le sample.xml

XML:

<?xml version="1.0" ?>
<Racks>
<Rack>VIS01</Rack>
<Rack>VIS02</Rack>
</Racks>

et le sample2.xml

XML:

<?xml version="1.0" ?>
<Racks>
<Rack>VIS01</Rack>
<Rack>VIS02</Rack>
<Rack>VIS03</Rack>
</Racks>

il sont dans un dossier
je met un classeur dans le dossier sous le nom de "rewriteXml.xlsm"
dans le quel je met ce code

VB:

'***************************************************************************************************************************
'**********************************************************************************
' __        _____  ___   .  ___         _____  ___             ___
'|__|  /\     |   |   |  | |     | /      |   |   | |   | |   |   | |\  |
'|    /__\    |   |---   | |     |/\      |   |   | |   | |   |   | | \ |
'|   /    \   |   |   \  | |___  |  \     |   |___| |___| |__ |___| |  \|
'
'***********************************************************************************
'                             COLLECTION travaux XML et customUI
'                                 Extrait du module XML
'*Auteur: patricktoulon sur exceldownload
'*Version: 2023 1.0                                                                                                                                                                                                                                           *
'*date version: 01/08/2023
'*rewrite and add balise rack in XML document

Sub test()
'loader un fichier
    Dim XmlDoC, i&, a&, CoDXmL As String, x, fichier As String

    If Dir(ThisWorkbook.Path & "\copie Xml", vbDirectory) = "" Then
        MkDir ThisWorkbook.Path & "\copie Xml"
    Else
        Kill ThisWorkbook.Path & "\copie Xml\*.*"
    End If
   
    fic = Dir(ThisWorkbook.Path & "\*.xml")
Set XmlDoC = CreateObject("Microsoft.XMLDOM")
     
    Do While fic <> ""

        DoEvents
         'on load le document XML
        'XmlDoC.Async = "false"
        'XmlDoC.Load fic

        'au cas ou la structure n'aurait pas de post processing ou des erreurs
        'on load le code dans un documentXML en récupérant le string du code avec open binnary
        x = FreeFile: Open ThisWorkbook.Path & "\" & fic For Binary Access Read As #x: CoDXmL = String(LOF(x), " "): Get #x, , CoDXmL: Close #x
        If Not XmlDoC.LoadXML(CoDXmL) Then Err.Raise docxml.parseError.ErrorCode, , docxml.parseError.reason

       '
        Set rack = XmlDoC.getelementsbytagname("Rack")
        For i = 0 To rack.Length - 1
            For a = 1 To 99
                Set newrack = XmlDoC.createelement("Rack")
                newrack.Text = rack(i).Text & "_" & Format(a, "00")
                rack(i).ParentNode.appendchild newrack
            Next
            rack(i).ParentNode.RemoveChild (rack(i))
        Next

        'sauver le xml non indenté (code valide mais en vrac)
        'XmlDoC.Save ThisWorkbook.Path & "\copie Xml" & "\copie_de_" & fic

        'OU
       
        'sauver le xml avec indentation(code valide indenté)
        SaveFormatDocToFileXL XmlDoC, ThisWorkbook.Path & "\copie Xml" & "\copie_de_" & fic

        fic = Dir

    Loop
    Set XmlDoC = Nothing
End Sub
'enregistrer le xml  au format utf-8 et indenté
Public Sub SaveFormatDocToFileXL(ByVal doc, ByVal FileName As String)
    Dim ReaderXml As Object, StreamFormaté As Object, WriterFormat As Object, elem

    Set ReaderXml = CreateObject("MSXML2.SAXXMLReader.6.0")
    Set StreamFormaté = CreateObject("ADODB.Stream")
    Set WriterFormat = CreateObject("MSXML2.MXXMLWriter")

    With StreamFormaté
        .Open
        .Type = 1    'adTypeBinary
        With WriterFormat
            .omitXMLDeclaration = True
            '.standalone = True
            .byteOrderMark = False    'If not set (even to False) then
            '.encoding is ignored.
            '.Encoding = "utf-8"    'Even if .byteOrderMark = True
            'UTF-8 never gets a BOM.
            .indent = True
            .output = StreamFormaté
            With ReaderXml
                Set .contentHandler = WriterFormat
                Set .dtdHandler = WriterFormat
                Set .errorHandler = WriterFormat
                .putProperty "http://xml.org/sax/properties/lexical-handler", WriterFormat
                .putProperty "http://xml.org/sax/properties/declaration-handler", WriterFormat
                .Parse doc
            End With
        End With
        .SaveToFile FileName
        .Close
    End With
    Set ReaderXml = Nothing
    Set StreamFormaté = Nothing
    Set WriterFormat = Nothing
End Sub

voila voila nous y sommes
voilà ce que l'on a au départ

on lance la sub test
et à l'arrivée

enjoy
Bonjour Bruno

Poisss · 1 Août 2023

VB:

Sub UnzipFilesAndModifyBlocksXML()
    Dim FSO As Object
    Dim objShell As Object
    Dim zipPath As String
    Dim unzipFolder As String
    Dim folderName As String
    Dim blocksFilePath As String
    Dim blocksContent As String
    Dim racksPattern As String
    Dim racksMatches As Object
    Dim rackMatch As Object
    Dim line As Variant
    Dim i As Integer
    Dim rackIncrement As Integer
    Dim startTag As String
    Dim endTag As String
    Dim uniqueLines As Object
    
    ' Chemins réels des répertoires
    zipPath = "\\DATA-BE\DonneesTechnologiques\SERVICE INDUSTRIALISATION\99 - Dossiers Personnels\Lucas\NCP\076-Ligne STS\Modification Programme\PRG_ZIP\"
    unzipFolder = "\\DATA-BE\DonneesTechnologiques\SERVICE INDUSTRIALISATION\99 - Dossiers Personnels\Lucas\NCP\076-Ligne STS\Modification Programme\PRG_DEZIP\"
    
    ' Initialisation des objets FileSystem et Shell
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set objShell = CreateObject("Shell.Application")
    
    ' Vérifie si le répertoire de destination existe, sinon le crée
    If Not FSO.FolderExists(unzipFolder) Then
        FSO.CreateFolder (unzipFolder)
    End If
    
    ' Parcours chaque fichier zip dans le répertoire donné
    Dim zipFile As Object
    For Each zipFile In FSO.GetFolder(zipPath).Files
    
    blocksFilePath = ""
    
        If LCase(FSO.GetExtensionName(zipFile.Path)) = "zip" Then
            ' Crée un répertoire avec le nom du fichier zip sans l'extension
            folderName = FSO.GetBaseName(zipFile.Name)
            FSO.CreateFolder (unzipFolder & folderName)
            
            ' Extrait les fichiers du fichier zip dans le répertoire créé
            objShell.Namespace(unzipFolder & folderName).CopyHere objShell.Namespace(zipFile.Path).Items
            
            ' Vérifie si le dossier commence par "A"
            If Left(folderName, 1) = "A" Then
                ' Récupère le chemin complet du fichier Blocks.xml
                blocksFilePath = unzipFolder & folderName & "\Blocks.xml"
                
                ' Vérifie si le fichier Blocks.xml existe
                If FSO.FileExists(blocksFilePath) Then
                                
                    ' Lecture du contenu du fichier Blocks.xml
                    blocksContent = FSO.OpenTextFile(blocksFilePath, 1, False).ReadAll
                    
                    ' Utiliser des expressions régulières pour rechercher toutes les lignes entre <Racks> et </Racks>
                    racksPattern = "<Racks>([\s\S]*?)<\/Racks>"
                    Set racksMatches = GetRegexMatches(blocksContent, racksPattern)
                    
                    ' Parcourir toutes les correspondances trouvées
                    For Each rackMatch In racksMatches
                        ' Récupérer le contenu entre <Racks> et </Racks>
                        
                        Dim racksContent As String
                        racksContent = rackMatch.SubMatches(0)
                        
                        ' Utiliser des expressions régulières pour rechercher toutes les valeurs entre > et <
                        Dim valuesPattern As String
                        
                        valuesPattern = "<Rack>(.*?)</Rack>"
                        Dim valuesMatches As Object
                        Set valuesMatches = GetRegexMatches(racksContent, valuesPattern)
                        
                        ' Créer les nouvelles lignes avec les valeurs incrémentées de 01 à 99
                        Dim newLines As String
                        Set uniqueLines = CreateObject("Scripting.Dictionary")
                        For Each line In valuesMatches
                            Dim value As String
                            value = line.SubMatches(0)
                            If Not uniqueLines.Exists(value) Then
                                uniqueLines(value) = 1
                                For i = 1 To 99
                                    Dim increment As String
                                    increment = Format(i, "00")
                                    newLines = newLines & vbNewLine & "<Rack>" & value & "-" & increment & "</Rack>"
                                Next i
                            End If
                        Next line
                        
                        ' Remplacer le contenu entre <Racks> et </Racks> par les nouvelles lignes dans le fichier Blocks.xml
                        blocksContent = Replace(blocksContent, racksContent, newLines)
                    Next rackMatch
                    
                    ' Écrire le contenu modifié dans le fichier Blocks.xml
                    Dim blocksFileOut As Object
                    Set blocksFileOut = FSO.CreateTextFile(blocksFilePath, True)
                    blocksFileOut.Write blocksContent
                    blocksFileOut.Close
                End If
            End If
        End If
    Next zipFile
    
    ' Libérer les objets
    Set objShell = Nothing
    Set FSO = Nothing
    
    MsgBox "Décompression et modification terminées !", vbInformation
End Sub

Function GetRegexMatches(inputString As String, pattern As String) As Object
    Dim regex As Object
    Set regex = CreateObject("VBScript.RegExp")
    regex.Global = True
    regex.IgnoreCase = True
    regex.pattern = pattern
    Set GetRegexMatches = regex.Execute(inputString)
End Function

Poisss · 1 Août 2023

Bonjour patricktoulon,

Merci pour ton aide.

Je suis encore novice en VBA, je ne sais pas si cela a un impact mais mon fichier XML ne contient pas que des lignes <Rack>... (Tu trouveras un exemple en PJ.)

Il y en a d'autre, ton code permet d'incrémenter seulement où sont présente les lignes ?

Et de plus, chaque fichier xml est dans un sous-dossier, eux même dans un dossier. (Image en PJ)

PS : j'ai rajouté mon code dans le message au-dessus si jamais, le code fonctionne bien, mais le problème est qu'il "garde" en mémoire les lignes des fichiers d'avant.

Merci, Lucas.

patricktoulon · 1 Août 2023

re
et oui mais si tu donne les elements du problème au compte goutte on va pas s'en sortir là
ça veut dire déjà que la boucle DIR doit être récursive(dossier/fichiers)
en suite si il y a d'autre tags il faudra expliquer ce que tu veux une bonne fois pour toute

Poisss · 1 Août 2023

Autant pour moi (première conversation à laquelle je participe sur le forum).

Je reprends tout depuis le début :

J'ai un dossier rempli de fichier .zip, chaque .zip contient 4 fichiers textes dont le fichier Blocks.xml que je souhaite modifier.

Disons que le chemin du dossier rempli de zip est :
C:\Users\lpoissonneau\OneDrive\Documents\Modification Programme\PRG_ZIP
ET
Disons que le chemin du dossier où je souhaite dézipper chaque fichier, créer un dossier avec le même nom que le fichier .zip sans l'extension et mettre les 4 fichiers textes à l'intérieur est : C:\Users\lpoissonneau\OneDrive\Documents\Modification Programme\PRG_DEZIP

Une fois cela fait, il faut que ma macro puisse modifier les fichiers Blocks.xml de chaque dossier entre les balises :
<Racks>
et
</Racks>,

Voici un début de fichier Blocks.xml avec les balises :

<xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx>
<xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx>
<xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx>
<Program>1</Program>
<Command>1</Command>
<Racks>
<Rack>VIS01</Rack>
<Rack>VIS02</Rack>
</Racks>
....

Dans ce fichier appartenant au dossier "A016-03-V01"
On retrouve deux lignes différente entre les balises, il faut que je puisse incrémenter chacune comme ceci :
-01
-02
...
-99

Or, les lignes sont rarement les mêmes selon le fichier : on peut avoir seulement VIS01, ou VIS 02, ou PLA01, ..., ou plusieurs en même temps.

VIS01, VIS02, ... sont des types d'outillages, je souhaite attribuer un identifiant unique à chaque outillage (inexistant aujourd'hui).

Il faut alors que ma macro repère quel type d'outillage est présent dans les fichiers, et incrémente pour chaque type d'outillage de -01 à -99.

Je remet mon code qui ne fonctionne pas ci-dessous, j'espère que c'est plus compréhensible.

VB:

Sub UnzipFilesAndModifyBlocksXML()
    Dim FSO As Object
    Dim objShell As Object
    Dim zipPath As String
    Dim unzipFolder As String
    Dim folderName As String
    Dim blocksFilePath As String
    Dim blocksContent As String
    Dim racksPattern As String
    Dim racksMatches As Object
    Dim rackMatch As Object
    Dim line As Variant
    Dim i As Integer
    Dim rackIncrement As Integer
    Dim startTag As String
    Dim endTag As String
    Dim uniqueLines As Object
    
    ' Chemins réels des répertoires
    zipPath = "C:\Users\lpoissonneau\OneDrive\Documents\Modification Programme\PRG_ZIP\"
    unzipFolder = "C:\Users\lpoissonneau\OneDrive\Documents\Modification Programme\PRG_DEZIP\"
    
    ' Initialisation des objets FileSystem et Shell
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set objShell = CreateObject("Shell.Application")
    
    ' Vérifie si le répertoire de destination existe, sinon le crée
    If Not FSO.FolderExists(unzipFolder) Then
        FSO.CreateFolder (unzipFolder)
    End If
    
    ' Parcours chaque fichier zip dans le répertoire donné
    Dim zipFile As Object
    For Each zipFile In FSO.GetFolder(zipPath).Files
    
        If LCase(FSO.GetExtensionName(zipFile.Path)) = "zip" Then
            ' Crée un répertoire avec le nom du fichier zip sans l'extension
            folderName = FSO.GetBaseName(zipFile.Name)
            FSO.CreateFolder (unzipFolder & folderName)
            
            ' Extrait les fichiers du fichier zip dans le répertoire créé
            objShell.Namespace(unzipFolder & folderName).CopyHere objShell.Namespace(zipFile.Path).Items
            
            ' Vérifie si le dossier commence par "A"
            If Left(folderName, 1) = "A" Then
                ' Récupère le chemin complet du fichier Blocks.xml
                blocksFilePath = unzipFolder & folderName & "\Blocks.xml"
                
                ' Vérifie si le fichier Blocks.xml existe
                If FSO.FileExists(blocksFilePath) Then
                                
                    ' Lecture du contenu du fichier Blocks.xml
                    blocksContent = FSO.OpenTextFile(blocksFilePath, 1, False).ReadAll
                    
                    ' Utiliser des expressions régulières pour rechercher toutes les lignes entre <Racks> et </Racks>
                    racksPattern = "<Racks>([\s\S]*?)<\/Racks>"
                    Set racksMatches = GetRegexMatches(blocksContent, racksPattern)
                    
                    ' Parcourir toutes les correspondances trouvées
                    For Each rackMatch In racksMatches
                        ' Récupérer le contenu entre <Racks> et </Racks>
                        
                        Dim racksContent As String
                        racksContent = rackMatch.SubMatches(0)
                        
                        ' Utiliser des expressions régulières pour rechercher toutes les valeurs entre > et <
                        Dim valuesPattern As String
                        
                        valuesPattern = "<Rack>(.*?)</Rack>"
                        Dim valuesMatches As Object
                        Set valuesMatches = GetRegexMatches(racksContent, valuesPattern)
                        
                        ' Créer les nouvelles lignes avec les valeurs incrémentées de 01 à 99
                        Dim newLines As String
                        Set uniqueLines = CreateObject("Scripting.Dictionary")
                        For Each line In valuesMatches
                            Dim value As String
                            value = line.SubMatches(0)
                            If Not uniqueLines.Exists(value) Then
                                uniqueLines(value) = 1
                                For i = 1 To 99
                                    Dim increment As String
                                    increment = Format(i, "00")
                                    newLines = newLines & vbNewLine & "<Rack>" & value & "-" & increment & "</Rack>"
                                Next i
                            End If
                        Next line
                        
                        ' Remplacer le contenu entre <Racks> et </Racks> par les nouvelles lignes dans le fichier Blocks.xml
                        blocksContent = Replace(blocksContent, racksContent, newLines)
                    Next rackMatch
                    
                    ' Écrire le contenu modifié dans le fichier Blocks.xml
                    Dim blocksFileOut As Object
                    Set blocksFileOut = FSO.CreateTextFile(blocksFilePath, True)
                    blocksFileOut.Write blocksContent
                    blocksFileOut.Close
                End If
            End If
        End If
    Next zipFile
    
    ' Libérer les objets
    Set objShell = Nothing
    Set FSO = Nothing
    
    MsgBox "Décompression et modification terminées !", vbInformation
End Sub

Function GetRegexMatches(inputString As String, pattern As String) As Object
    Dim regex As Object
    Set regex = CreateObject("VBScript.RegExp")
    regex.Global = True
    regex.IgnoreCase = True
    regex.pattern = pattern
    Set GetRegexMatches = regex.Execute(inputString)
End Function

Merci

Poisss · 1 Août 2023

Problème résolu !
Voici le code ci ça peut en aider certains ! La résolution est en ligne 103, un reset de la variable newlines entre chaque fichier texte.

Merci Patrick d'avoir pris du temps, et je m'expliquerais mieux la prochaine fois ! Promis !

VB:

Sub UnzipFilesAndModifyBlocksXML()
    Dim FSO As Object
    Dim objShell As Object
    Dim zipPath As String
    Dim unzipFolder As String
    Dim folderName As String
    Dim blocksFilePath As String
    Dim blocksContent As String
    Dim racksPattern As String
    Dim racksMatches As Object
    Dim rackMatch As Object
    Dim line As Variant
    Dim i As Integer
    Dim rackIncrement As Integer
    Dim startTag As String
    Dim endTag As String
    Dim uniqueLines As Object
    
    ' Chemins réels des répertoires
    zipPath = "C:\Users\lpoissonneau\OneDrive\Documents\Modification Programme\PRG_ZIP\"
    unzipFolder = "C:\Users\lpoissonneau\OneDrive\Documents\Modification Programme\PRG_DEZIP\"
    
    ' Initialisation des objets FileSystem et Shell
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set objShell = CreateObject("Shell.Application")
    
    ' Vérifie si le répertoire de destination existe, sinon le crée
    If Not FSO.FolderExists(unzipFolder) Then
        FSO.CreateFolder (unzipFolder)
    End If
    
    ' Parcours chaque fichier zip dans le répertoire donné
    Dim zipFile As Object
    For Each zipFile In FSO.GetFolder(zipPath).Files
    
    blocksContent = ""
    
        If LCase(FSO.GetExtensionName(zipFile.Path)) = "zip" Then
            ' Crée un répertoire avec le nom du fichier zip sans l'extension
            folderName = FSO.GetBaseName(zipFile.Name)
            FSO.CreateFolder (unzipFolder & folderName)
            
            ' Extrait les fichiers du fichier zip dans le répertoire créé
            objShell.Namespace(unzipFolder & folderName).CopyHere objShell.Namespace(zipFile.Path).Items
            
            ' Vérifie si le dossier commence par "A"
            If Left(folderName, 1) = "A" Then
                ' Récupère le chemin complet du fichier Blocks.xml
                blocksFilePath = unzipFolder & folderName & "\Blocks.xml"
                
                ' Vérifie si le fichier Blocks.xml existe
                If FSO.FileExists(blocksFilePath) Then
                                
                    ' Lecture du contenu du fichier Blocks.xml
                    blocksContent = FSO.OpenTextFile(blocksFilePath, 1, False).ReadAll
                    
                    ' Utiliser des expressions régulières pour rechercher toutes les lignes entre <Racks> et </Racks>
                    racksPattern = "<Racks>([\s\S]*?)<\/Racks>"
                    Set racksMatches = GetRegexMatches(blocksContent, racksPattern)
                    
                    ' Parcourir toutes les correspondances trouvées
                    For Each rackMatch In racksMatches
                        ' Récupérer le contenu entre <Racks> et </Racks>
                        
                        Dim racksContent As String
                        racksContent = rackMatch.SubMatches(0)
                        
                        ' Utiliser des expressions régulières pour rechercher toutes les valeurs entre > et <
                        Dim valuesPattern As String
                        
                        valuesPattern = "<Rack>(.*?)</Rack>"
                        Dim valuesMatches As Object
                        Set valuesMatches = GetRegexMatches(racksContent, valuesPattern)
                        
                        ' Créer les nouvelles lignes avec les valeurs incrémentées de 01 à 99
                        Dim newLines As String
                        Set uniqueLines = CreateObject("Scripting.Dictionary")
                        For Each line In valuesMatches
                            Dim value As String
                            value = line.SubMatches(0)
                            If Not uniqueLines.Exists(value) Then
                                uniqueLines(value) = 1
                                For i = 1 To 99
                                    Dim increment As String
                                    increment = Format(i, "00")
                                    newLines = newLines & vbNewLine & "<Rack>" & value & "-" & increment & "</Rack>"
                                Next i
                            End If
                        Next line
                        
                        ' Remplacer le contenu entre <Racks> et </Racks> par les nouvelles lignes dans le fichier Blocks.xml
                        blocksContent = Replace(blocksContent, racksContent, newLines)
                        
                    Next rackMatch
                    
                    ' Écrire le contenu modifié dans le fichier Blocks.xml
                    Dim blocksFileOut As Object
                    Set blocksFileOut = FSO.CreateTextFile(blocksFilePath, True)
                    blocksFileOut.Write blocksContent
                    blocksFileOut.Close
                    End If
                    
                    newLines = ""
                    
            End If
        End If
    Next zipFile
    
    ' Libérer les objets
    Set objShell = Nothing
    Set FSO = Nothing
    
    MsgBox "Décompression et modification terminées !", vbInformation
End Sub

Function GetRegexMatches(inputString As String, pattern As String) As Object
    Dim regex As Object
    Set regex = CreateObject("VBScript.RegExp")
    regex.Global = True
    regex.IgnoreCase = True
    regex.pattern = pattern
    Set GetRegexMatches = regex.Execute(inputString)
End Function

patricktoulon · 1 Août 2023

Attention quand même le regexpand est capricieux sur certaine version 365
si je pouvait avoir 2 ou 3 zip je regarderais si je peux le faire avec la librairie idoine

Usine à gaz · 1 Août 2023

patricktoulon à dit:
Attention quand même le regexpand est capricieux sur certaine version 365
si je pouvait avoir 2 ou 3 zip je regarderais si je peux le faire avec la librairie idoine

lol c'est pas " idoine" c'est "iguane"
je sors

patricktoulon · 1 Août 2023

re
tu va prendre 2 h de colle toi tu va voir

Microsoft 365 Modification fichiers .xml via macro

Poisss

XLDnaute Nouveau

Compte Supprimé 979

Guest

patricktoulon

XLDnaute Barbatruc

Poisss

XLDnaute Nouveau

Poisss

XLDnaute Nouveau

Pièces jointes

patricktoulon

XLDnaute Barbatruc

Poisss

XLDnaute Nouveau

Poisss

XLDnaute Nouveau

patricktoulon

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Discussions similaires