Microsoft 365 Renommer fichier txt via Macro selon son contenu

DELATTE · 3 Septembre 2024

Bonjour à tous amis Excelleurs,

Je fais appel à votre aide concernant une macro qui permettrait de renommer des fichiers TXT selon deux lignes de son contenu.

En effet, je télécharge chaque jour des fichiers XML d'extraits bancaires mais le nom standard du fichier ne me permet pas de le comprendre.

Quel serait la macro qui permettrait de renommer le fichier ci-joint selon la ligne 25 (numéro de compte) et la ligne 28C (numéro extrait) et dont le résultat serait :
"BGLLLULL-LU000000000000000000-00064".

Et ensuite de faire fonctionner cette macro sur un volume de fichiers txt stockés dans un répertoire ?

Un grand merci pour votre aide toujours excellente.

Bien à vous,

danielco · 3 Septembre 2024

Bonjour,

Essaie :

VB:

Sub test()
  Dim Fich As String, Txt As String, Enrgt As String, Chemin As String
  Chemin = "d:\Users\dcola\Downloads\"
  Fich = "TEST.txt"
  Close #1
  Open Chemin & Fich For Input As #1
  Do While Not EOF(1)
    Line Input #1, Enrgt
    If Left(Enrgt, 4) = ":25:" Then
      Enrgt = Replace(Enrgt, "/", "-")
      Txt = Mid(Enrgt, 5, 9 ^ 9)
    ElseIf Left(Enrgt, 5) = ":28C:" Then
      Enrgt = Replace(Enrgt, "/", "-")
      Txt = Txt & "-" & Mid(Enrgt, 6, Len(Enrgt) - 8) & ".txt"
      Exit Do
    End If
  Loop
  Close #1
  Name Chemin & Fich As Chemin & Txt
End Sub

Si c'est bon, j'ajouterai la boucle.

Daniel

DELATTE · 3 Septembre 2024

Bonjour Daniel,

Cela fonctionne parfaitement.
Est-il possible de sélectionner un ensemble de fichiers en une seule fois par l'explorateur ?
Afin d'éviter la sélection du nom.
Encore un grand merci pour ton aide.
Bien à toi,

danielco · 3 Septembre 2024

Essaie :

VB:

Sub test1()
  Dim Fich As String, Txt As String, Enrgt As String, Chemin As String
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
  With FldrPicker
    .Title = "Choisissez un dossier"
    .AllowMultiSelect = False
    If .Show <> -1 Then Exit Sub 'Check if user clicked cancel button
    Chemin = .SelectedItems(1) & "\"
  End With
  Fich = Dir(Chemin)
  Do While Fich <> ""
    Close #1
    Open Chemin & Fich For Input As #1
    Do While Not EOF(1)
      Line Input #1, Enrgt
      If Left(Enrgt, 4) = ":25:" Then
        Enrgt = Replace(Enrgt, "/", "-")
        Txt = Mid(Enrgt, 5, 9 ^ 9)
      ElseIf Left(Enrgt, 5) = ":28C:" Then
        Enrgt = Replace(Enrgt, "/", "-")
        Txt = Txt & "-" & Mid(Enrgt, 6, Len(Enrgt) - 8) & ".txt"
        Exit Do
      End If
      Fich = Dir
    Loop
    Close #1
    Name Chemin & Fich As Chemin & Txt
  Loop
End Sub

Daniel

DELATTE · 3 Septembre 2024

Encore un grand merci pour ta rapidité.

Je viens de faire le test mais seul le premier fichier est renommé et ensuite la macro bloque sur cette ligne en jaune :

-------------------------------------------------------------------------
Sub test2()

Dim Fich As String, Txt As String, Enrgt As String, Chemin As String

Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

With FldrPicker

.Title = "Choisissez un dossier"

.AllowMultiSelect = False

If .Show <> -1 Then Exit Sub 'Check if user clicked cancel button

Chemin = .SelectedItems(1) & "\"

End With

Fich = Dir(Chemin)

Do While Fich <> ""

Close #1

Open Chemin & Fich For Input As #1

Do While Not EOF(1)

Line Input #1, Enrgt

If Left(Enrgt, 4) = ":25:" Then

Enrgt = Replace(Enrgt, "/", "-")

Txt = Mid(Enrgt, 5, 9 ^ 9)

ElseIf Left(Enrgt, 5) = ":28C:" Then

Enrgt = Replace(Enrgt, "/", "-")

Txt = Txt & "-" & Mid(Enrgt, 6, Len(Enrgt) - 9) & ".94E"

Exit Do

End If

Fich = Dir

Loop

Close #1

Name Chemin & Fich As Chemin & Txt

Loop

End Sub

------------------------------------------

Merci d'avance.

Bien à toi,

DELATTE · 3 Septembre 2024

A chaque relance de la macro, un seul fichier supplémentaire est renommé.

danielco · 3 Septembre 2024

Quel est le libellé et le code de l'erreur ? Indépendamment de ça, je viens de penser que la macro ne va jamais s'arrêter. Les fichiers renommés vont être lus et relus à l'infini. Il faut les placer dans un autre dossier.

Daniel

danielco · 3 Septembre 2024

Désolé. Je pense avoir trouvé. Essaie :

VB:

Sub test1()
  Dim Fich As String, Txt As String, Enrgt As String, Chemin As String
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
  With FldrPicker
    .Title = "Choisissez un dossier"
    .AllowMultiSelect = False
    If .Show <> -1 Then Exit Sub 'Check if user clicked cancel button
    Chemin = .SelectedItems(1) & "\"
  End With
  Fich = Dir(Chemin & "*.txt")
  Do While Fich <> ""
    Debug.Print Fich
    Close #1
    Open Chemin & Fich For Input As #1
    Do While Not EOF(1)
      Line Input #1, Enrgt
      If Left(Enrgt, 4) = ":25:" Then
        Enrgt = Replace(Enrgt, "/", "-")
        Txt = Mid(Enrgt, 5, 9 ^ 9)
      ElseIf Left(Enrgt, 5) = ":28C:" Then
        Enrgt = Replace(Enrgt, "/", "-")
        Txt = Txt & "-" & Mid(Enrgt, 6, Len(Enrgt) - 8) & ".txt"
        Exit Do
      End If
    Loop
    Close #1
    Name Chemin & Fich As Chemin & Txt9
    Fich = Dir()
  Loop
End Sub

Daniel

job75 · 3 Septembre 2024

Bonjour DELATTE, danielco;

Il y a une coquille dans la dernière macro avec Text9

Par ailleurs si 2 fichiers textes ont le même contenu il faut ajouter On Error Resume Next :

VB:

On Error Resume Next
Name Chemin & Fich As Chemin & Txt

A+

danielco · 3 Septembre 2024

Bonjour job75

Tu as tout à fait raison. Le code devient donc :

VB:

Sub test1()
  Dim Fich As String, Txt As String, Enrgt As String, Chemin As String
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
  With FldrPicker
    .Title = "Choisissez un dossier"
    .AllowMultiSelect = False
    If .Show <> -1 Then Exit Sub 'Check if user clicked cancel button
    Chemin = .SelectedItems(1) & "\"
  End With
  Fich = Dir(Chemin & "*.txt")
  Do While Fich <> ""
    Debug.Print Fich
    Close #1
    Open Chemin & Fich For Input As #1
    Do While Not EOF(1)
      Line Input #1, Enrgt
      If Left(Enrgt, 4) = ":25:" Then
        Enrgt = Replace(Enrgt, "/", "-")
        Txt = Mid(Enrgt, 5, 9 ^ 9)
      ElseIf Left(Enrgt, 5) = ":28C:" Then
        Enrgt = Replace(Enrgt, "/", "-")
        Txt = Txt & "-" & Mid(Enrgt, 6, Len(Enrgt) - 8) & ".txt"
        Exit Do
      End If
    Loop
    Close #1
    On Error Resume Next
    Name Chemin & Fich As Chemin & Txt
    Fich = Dir()
  Loop
End Sub

Encore merci.

Daniel

DELATTE · 3 Septembre 2024

Un grand merci à tous les deux.

Si je peux encore abuser de vos services, je voudrais appliquer ces petites modifications :

- Lex extensions des fichiers XML sont soit ".94E", soit ".94N" : est-il possible d'enregistrer le nouveau nom en conservant l'extension d'origine, peu importe l'extension ?

- le numéro de l'extrait se situe soit après la référence ":28:" ou ":28C:" Peut-on adapter la macro dans ce sens ?

- et le nombre de caractères varie après les ":" , donc il faudrait conserver tous les caractères après ces ":", en remplaçant le "/" par "-" tel que :28C:00064/001 qui donnerait 00064-001.

Encore merci pour votre temps.

Bien à vous,

job75 · 4 Septembre 2024

Bonjour DELATTE, danielco, le forum,

Cette macro traitera tous les fichiers du dossier choisi :

VB:

Sub Renommer()
Dim chemin$, fich$, ext$, x%, nom$, texte$
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Choisissez un dossier"
    .AllowMultiSelect = False
    If .Show = False Then Exit Sub
    chemin = .SelectedItems(1) & "\"
End With
fich = Dir(chemin & "*.*")
While fich <> ""
    ext = Mid(fich, InStrRev(fich, "."), 9)
    x = FreeFile
    Open chemin & fich For Input As #x 'ouverture en lecture séquentielle
    nom = ""
    Do While Not EOF(x)
        Line Input #x, texte
        If texte Like ":28:*" Or texte Like ":28C:*" Then 'critère
            texte = Replace(texte, "/", "-")
            nom = Mid(texte, InStr(2, texte, ":") + 1, 9 ^ 9) & ext
            Exit Do
        End If
    Loop
    Close #x
    On Error Resume Next
    If nom <> "" Then Name chemin & fich As chemin & nom 'renomme le fichier
    On Error GoTo 0
    fich = Dir()
Wend
End Sub

On notera qu'ici le critère ":25:*" n'est pas utilisé.

A+

job75 · 4 Septembre 2024

Si maintenant il faut le 1er critère ":25:*" on utilisera :

VB:

Sub Renommer2()
Dim chemin$, fich$, ext$, x%, nom1$, nom$, texte$
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Choisissez un dossier"
    .AllowMultiSelect = False
    If .Show = False Then Exit Sub
    chemin = .SelectedItems(1) & "\"
End With
fich = Dir(chemin & "*.*")
While fich <> ""
    ext = Mid(fich, InStrRev(fich, "."), 9)
    x = FreeFile
    Open chemin & fich For Input As #x 'ouverture en lecture séquentielle
    nom1 = "": nom = ""
    Do While Not EOF(x)
        Line Input #x, texte
        If texte Like ":25:*" Then '1er critère
            nom1 = Mid(texte, 5, 9 ^ 9)
        ElseIf nom1 <> "" And (texte Like ":28:*" Or texte Like ":28C:*") Then '2ème critère
            nom = nom1 & "-" & Mid(texte, InStr(2, texte, ":") + 1, 9 ^ 9) & ext
            nom = Replace(nom, "/", "-")
            Exit Do
        End If
    Loop
    Close #x
    On Error Resume Next
    If nom <> "" Then Name chemin & fich As chemin & nom 'renomme le fichier
    On Error GoTo 0
    fich = Dir()
Wend
End Sub

DELATTE · 4 Septembre 2024

Un tout grand merci.

C'est parfait comme cela.

Excellente journée.

Bien à vous,

job75 · 4 Septembre 2024

Quelle macro vous intéresse ? Post #12 ou post #13 ?

Effectuez une recherche sur Excel Downloads...

Microsoft 365 Renommer fichier txt via Macro selon son contenu

DELATTE

XLDnaute Nouveau

Pièces jointes

danielco

XLDnaute Accro

DELATTE

XLDnaute Nouveau

danielco

XLDnaute Accro

DELATTE

XLDnaute Nouveau

DELATTE

XLDnaute Nouveau

danielco

XLDnaute Accro

danielco

XLDnaute Accro

job75

XLDnaute Barbatruc

danielco

XLDnaute Accro

DELATTE

XLDnaute Nouveau

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

DELATTE

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums