Macro pour rechercher-remplacer dans des dossiers avec fichiers Excel

Bonjour,

J’ai cette macro qui permet de remplacer n’importe quelle valeur par une autre, dans tous les fichiers contenus dans un dossier. Il suffit de mettre l’emplacement désigné en cellule B6 puis d’indiquer le terme à rechercher en B9 et le terme de remplacement en B11.
le problème c’est que en lançant la macro sur un dossier contenant des fichiers Excel il est impossible de rouvrir les fichiers.
j’obtiens le message d’erreur suivant : « impossible d’ouvrir le fichier car son format ou son extension n’est pas valide. Vérifier que le fichier n’est pas endommagé et que son extension correspond bien au format du fichier. »

Pourtant j’ai bien coché la référence Microsoft Excel 16.0 Object Library dans outil.

Auriez vous une solution ?

Merci d’avance pour votre aide !!

Bonjour,

ton programme permet de remplacer des séquences de caractères dans des fichiers texte pas dans des fichiers qui ont leur format propre (excel word, powerpoint, ...)

pour excel, word, etc... ce sont en fait plusieurs fichiers rassemblés dans un fichier .ZIP. Si tu modifies ce fichier ZIP sans en connaitre la structure correcte tu vas les corrompre.

Pour moi la bonne façon de faire est d'avoir une macro qui ouvre les fichiers comme des fichiers excel, fait les chercher-remplacer avec des fonctions excel et ferme le fichier au format excel.

le code pourrait ressembler à ceci (non testé)

Sub traiter_dossier()

    Dim nom_dossier As String: Dim fichier As Object
    Dim le_dossier, chaque_fichier: Dim flux_lecture
    Dim ligne As Integer: Dim le_fichier As Object, sh As Object
    Dim contenu As String: Dim chercher As String: Dim remplacer As String

    nom_dossier = Range("B6").Value
    chercher = Range("B9").Value
    remplacer = Range("B11").Value

    ligne = 8

    chaque_fichier = Dir(nom_dossier & "\*.xls*")

    Do While chaque_fichier <> ""
        Set le_fichier = Workbooks.Open(nom_dossier & "\" & chaque_fichier)

        For Each sh In le_fichier.Worksheets

            sh.Cells.Replace what:=chercher, Replacement:=remplacer, lookat:=xlPart

        Next sh

        le_fichier.Close

        Cells(ligne, 7).Value = chaque_fichier
        Cells(ligne, 9).Value = "Ok"

        ligne = ligne + 1
        chaque_fichier = Dir()
    Loop

End Sub

Bonjour h2so4,

Merci beaucoup pour ta réponse hyper rapide !

J’ai essayé avec ton code mais cela bloque (je pense) au niveau de l’ouverture du fichier Excel :

Set le_fichier=Workbooks.Open(nom_dossier & « \ »&chaque_fichier)

Je reçois un code d’erreur 1004 car le format ou l’extension n’est pas valide

Pourrais tu encore un peu m’aider stp ?

Bonjour,

le code tel que je l'ai fourni fonctionne chez moi. Voici une adaption du code, qui devrait permettre de comprendre d'où vient l'erreur.

Sub traiter_dossier()

    Dim nom_dossier As String: Dim fichier As Object
    Dim le_dossier, chaque_fichier: Dim flux_lecture
    Dim ligne As Integer: Dim le_fichier As Object, sh As Object
    Dim contenu As String: Dim chercher As String: Dim remplacer As String, traitement As String

    nom_dossier = Range("B6").Value
    chercher = Range("B9").Value
    remplacer = Range("B11").Value

    ligne = 8

    chaque_fichier = Dir(nom_dossier & "\*.xls*")

    Do While chaque_fichier <> ""
        Cells(ligne, 7).Value = nom_dossier & "\" & chaque_fichier

        On Error Resume Next
        Set le_fichier = Workbooks.Open(nom_dossier & "\" & chaque_fichier)
        If le_fichier Is Nothing Then
            traitement = "pas ok" & Error(Err) & " " & Err.Description
            On Error GoTo 0
        Else
            On Error GoTo 0
            For Each sh In le_fichier.Worksheets

                sh.Cells.Replace what:=chercher, Replacement:=remplacer, lookat:=xlPart

            Next sh
            traitement = "ok"
            le_fichier.Close
        End If

        Cells(ligne, 9).Value = traitement

        ligne = ligne + 1
        chaque_fichier = Dir()
    Loop

End Sub

C’est bon j’ai adapté est ça fonctionne !!

Merci beaucoup pour ton aide :)

bonjour,

une version adaptée pour faire un remplacement d'une chaine par une autre dans tous les fichiers excel (xls*) d'un répertoire et tous ses sous-répertoires.

Sub traiter_dossier()

    Dim nom_dossier As String
    Dim fs As Object
    Application.ScreenUpdating = False
    nom_dossier = "d:\downloads\test" '<- à adapter
    chercher = "Alpha" '<- à adapter
    remplacer = "Beta" '<- à adapter
    Set fs = CreateObject("scripting.filesystemobject")
    faireremplacement fs, nom_dossier, chercher, remplacer
End Sub
Sub faireremplacement(fs As Object, nom_dossier, chercher, remplacer)
    Set rep = fs.getfolder(nom_dossier)
    For Each fichier In rep.Files
    If fichier.Name Like "*.xls*" Then
        ligne = ligne + 1
        Cells(ligne, 1).Value = fichier.Path
        On Error Resume Next
        Set le_fichier = Workbooks.Open(fichier)
        If le_fichier Is Nothing Then
            traitement = "pas ok" & Error(Err) & " " & Err.Description
            On Error GoTo 0
        Else
            On Error GoTo 0
            For Each sh In le_fichier.Worksheets
                sh.Cells.Replace what:=chercher, Replacement:=remplacer, lookat:=xlPart
            Next sh
            traitement = "ok"
            le_fichier.Close Savechanges:=True
        End If

        Cells(ligne, 2).Value = traitement
        End If
   Next fichier
    For Each repertoire In rep.subFolders
        faireremplacement fs, repertoire.Path, chercher, remplacer
    Next repertoire
End Sub