Relever mots-clés de fichiers Word vers un tableau Excel

[nicolo9]

Bonjour,

Après plusieurs recherches sur des forums, je n'ai toujours pas trouvé comment récupérer des mots d'un fichier Word (ou même Excel) pour les écrire dans une case bien précise dans Excel.

Je m'explique : Mon but est de répertorier tous les dossiers/fichiers enregistrés dans le réseau informatique de l'usine dans laquelle je travaille.

De ce fait, j'organise une page Excel comme l'image ci-jointe :

Cellule	B	C	D
4	Nom du sous-dossier	Type de sous-dossier/fichier	Mots-clés
5	DOSSIER 1	Dossier de fichiers	?
6	Fichier1.xlsx	Feuille de calcul Microsoft Excel	?
7	Fichier2.exe	Application	?
8	Fichier3.doc	Document Microsoft Word 97-2003	?
9	Fichier4.ppt	Présentation Microsoft Powerpoint 97-2003	?
10	DOSSIER 2	Dossier de fichiers	?
11	Fichier1.xlsx	Feuille de calcul Microsoft Excel	?
12	Fichier2.exe	Application	?
13	Fichier3.doc	Document Microsoft Word 97-2003	?
14	Fichier4.txt	Document texte	?
15	...	...	...
16	...	...	...

<tbody>
</tbody>

Grâce à ma macro « Exécution », j’arrive à récupérer tous mes fichiers et dossiers dans le tableau de B5:Bfin pour les noms et de C5:Cfin pour les types du fichier. (En A1 j'ai mon dossier parent en path [C:\.......])

Sub Exécution()
    Dim path As String
    Dim myaddress As String
    Dim myRange As Range
    myaddress = "B4"
    Set myRange = Range(myaddress)
'Initialisation du chemin
     path = Range("A1").Value
    Call Lister_le_contenu(path, myRange)
End Sub

Avec la macro intermédiaire Lister_le_contenu :

Sub Lister_le_contenu(p_Path As String, ByRef p_Range As Range)
    Dim fso As New FileSystemObject
    Dim f As Folder
    Dim sf As Folder
    Dim myfile As File
    Dim myRange As Range
    Set myRange = p_Range
'Réference à l’objet du dossier
     Set f = fso.GetFolder(p_Path)
'Relever les sous-dossiers
     For Each sf In f.SubFolders
    myRange.Offset(1, 1).Value = sf.Name
    myRange.Offset(1, 2).Value = sf.Type
    Set myRange = myRange.Offset(1, 0)
    Next
'Relever les fichiers
     For Each myfile In f.Files
    myRange.Offset(1, 1).Value = myfile.Name
    myRange.Offset(1, 2).Value = myfile.Type
    myfile.Name
    Set myRange = myRange.Offset(1, 0)
    Call Lister_le_contenu(sf.path, myRange)
    Next
    Set p_Range = myRange
End Sub

Cependant pour les mots-clés, je ne sais pas comment m’y prendre pour relever un certain texte.

Mes fichiers Word sont disposés comme ceci :
1ère ligne : « Titre du document »
2ème ligne : « Mots-clés : abc, def, ghi, … »

Mes fichiers Excel sont disposés comme ceci :
A1 : « Titre du document »
A2 : « Mots-clés : abc, def, ghi, … »

J’ai déjà réussi à récupérer les mots clés dans des fichiers texte avec la macro :
(dans mon cas, j’ai écris ma ligne « Mots-clés : abc, def, ghi, … » sur la ligne 7).

Sub Mots_clés_fichier_txt()
    Dim ifile As Integer
    ifile = FreeFile
    Dim x As Long
    Dim Data As String
    Open "H:\test.txt" For Input As #ifile
    x = 1
    Do While Not EOF(1)
    Line Input #ifile, Data 'Récupère ta ligne
     If x = 7 Then Cells(6, 4) = Data 'Inscrit Data dans la 1ere case de ton classeur
     x = x + 1
    Loop
    Close #ifile
End Sub

Par contre, cette macro me fait récupérer ma valeur de mots-clés dans la case A6 d’Excel, mais que pour un seul fichier. Or, je veux que ça se mette dans ma colonne D:D pour tous les fichiers en un coup (soit en D7 pour le Fichier2.exe, D8 pour le Fichier3.doc, etc...).

J’avais pensé à ouvrir, en macro, le fichier Word, le copier/coller en txt, copier la ligne avec les mots-clés, et supprimer ce fichier txt. Mais je n’y arrive pas du tout.


Merci de votre aide.
Bien à vous,
nicolo9.

 

[gosselien]

Bonjour,

pas certain que ça t'aide mais ceci lit les date d'un fichier "test.txt"
juste une ligne changée

si j'ai bien compris ....

x = 1
Do While Not EOF(1)
Line Input #ifile, Data 'Récupère ta ligne
Cells(x, 4) = Data 'Inscrit Data dans la 1ere case de ton classeur
x = x + 1
Loop

Pour récupérer les fichiers de ton pc (pour commencerà ce code fonctionne:

Option Explicit


' -----------
' FAQ Excel


Sub TestListeFichiers()
Dim Dossier As String, Debut, Chemin, Fic
Static TabTemp() As String
If Debut Then
ReDim TabTemp(1 To 1)
TabTemp(1) = Chemin
End If


Set Fic = CreateObject("Scripting.FileSystemObject")


'Définit le répertoire pour débuter la recherche de fichiers.
'(Attention à ne pas indiquer un répertoire qu contient trop de sous-dossiers ou de
'fichiers, sinon le temps de traitement va être très long).
Dossier = "C:\Users\l" ' à adapter !!!
'Appelle la procédure de recherche des fichiers
ListeFichiers Dossier
'Ajuste la largeur des colonnes A:E en fonction du contenu des cellules.
Columns("A:E").AutoFit
MsgBox "Terminé"
End Sub


Sub ListeFichiers(Repertoire As String)
'
'Nécessite d'activer la référence "Microsoft Scripting RunTime"
'Dans l'éditeur de macros (Alt+F11):
'Menu Outils
'Références
'Cochez la ligne "Microsoft Scripting RunTime".
'Cliquez sur le bouton OK pour valider.


Dim fso As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim i As Long
Range("A2:F65000").ClearContents
Set fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = fso.GetFolder(Repertoire)


'Récupère le numéro de la dernière ligne vide dans la colonne A.
i = Range("A65536").End(xlUp).Row + 1


'Boucle sur tous les fichiers du répertoire
For Each FileItem In SourceFolder.Files
'Inscrit le nom du fichier dans la cellule
Cells(i, 1) = FileItem.name
'Ajoute un lien hypertexte vers le fichier
'Indique la date de création
Cells(i, 2) = FileItem.DateCreated
'Indique la date de dernier acces
Cells(i, 3) = FileItem.DateLastAccessed
'' 'Indique la date de dernière modification
'' Cells(i, 4) = FileItem.DateLastModified
'Nom du répertoire
Cells(i, 4) = FileItem.ParentFolder


i = i + 1


Next FileItem


'--- Appel récursif pour lister les fichier dans les sous-répertoires ---.
'For Each SubFolder In SourceFolder.SubFolders
' ListeFichiers SubFolder.Path
'Next SubFolder


End Sub

 

[nicolo9]

Salut, il y a beaucoup d'informations, et je t'en remercie, je vais essayer ceci, et je reviens vers toi.

nicolo9.

 

[nicolo9]

Salut gosselien, salut à tous,

J'ai tenté tout ça, ça va.
Au niveau des mots-clés ce ne sont pas vraiment des dates que je recherche, mais un peu de tout.

En fait, il y a une ligne dans n'importe quel type de fichier (word, excel(, txt)) qui porte des noms de signet ("keywords") et ce que je veux c'est que ma macro Excel ouvre le fichier concerné, copie keywords sur la ligne correspondante, et referme le fichier.

Merci en tout cas. Si tu as d'autres idées, je serai ravi.