XL 2021 Macro pour changer les titres de fichier d'archive

[GAB76]

Bonjour,
Lors d'un stage en chimie, je dois changé les noms de fichier d'archive (26000 +) j'ai donc fais appelle a mon meilleur amis l'ia pour crée une macro via excel pour ouvrir les fichiers world trouvé un mot et prendre la phrase qui suit, mais excel refuse d'ouvrir les fichier .doc, je vous mets si dessous le code et merci de votre aide:

Sub ModifierTitresDocuments()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Dim docPath As String
Dim cheminAcces As String
Dim etude As String
Dim wordApp As Object
Dim wordDoc As Object

' Définir la feuille de calcul et trouver la dernière ligne
On Error Resume Next
Set ws = ThisWorkbook.Sheets("query") ' Remplacez "Sheet1" par le nom de votre feuille
On Error GoTo 0

If ws Is Nothing Then
MsgBox "La feuille de calcul spécifiée n'existe pas.", vbExclamation
Exit Sub
End If

lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

' Créer une instance de l'application Word
On Error Resume Next
Set wordApp = CreateObject("Word.Application")
On Error GoTo 0

If wordApp Is Nothing Then
MsgBox "Impossible de créer une instance de Word. Assurez-vous que Word est installé.", vbExclamation
Exit Sub
End If

' Boucler à travers chaque ligne du fichier Excel
For i = 2 To lastRow ' Supposons que la première ligne est l'en-tête
docPath = ws.Cells(i, 1).Value ' Colonne A pour les chemins des documents
cheminAcces = ws.Cells(i, 5).Value ' Colonne E pour les chemins d'accès

' Extraire le contenu de l'étude après le mot 'demande'
If InStr(1, LCase(cheminAcces), "demande") > 0 Then
etude = Trim(Mid(cheminAcces, InStr(1, LCase(cheminAcces), "demande") + Len("demande")))
Else
etude = cheminAcces
End If

' Ouvrir le document Word et modifier le titre
On Error Resume Next
Set wordDoc = wordApp.Documents.Open(docPath)
On Error GoTo 0

If Not wordDoc Is Nothing Then
wordDoc.BuiltInDocumentProperties("Title").Value = etude
wordDoc.Save
wordDoc.Close
Else
MsgBox "Impossible d'ouvrir le document : " & docPath, vbExclamation
End If
Next i

' Fermer l'application Word
wordApp.Quit
Set wordApp = Nothing

MsgBox "Les titres des documents ont été modifiés avec succès.", vbInformation
End Sub

 

[wDog66]

Bonsoir,

Pourquoi ne pas redemander à votre meilleur ami 🤔 🙄

 

[scraper]

Bonsoir Gab76
Ce code ne change pas les noms de fichiers. Il cherche à modifier la propriété title des documents.
Il faut un petit fichier excel avec 3 lignes et 2 documents à modifier, pour commencer à te répondre.
Si tu crois que le code correspondant à ton besoin ce serait étonnant. Pour qu'un code VBA fonctionne correctement il faut le déboguer en pas a pas.

 

[fanch55]

Bonjour, nul besoin d'excel pour faire du renommage de masse.
Il existe une multitude de micro -logiciels gratuits pour cela .

Téléchargements Renommeur de fichiers: 11 logiciels (gratuit) - Clubic

Les logiciels de renommage de fichiers permettent de modifier en masse les noms de vos fichiers selon des critères spécifiques, comme l’ajout de préfixes, la suppression de caractères ou le remplacement de mots...

www.clubic.com