Recherche d'une occurrence dans un répertoire de fichiers Word

Bonsoir à tous,

J'aimerai votre aide svp pour faire une recherche, je m'explique:

Dans la 1ere colonne d'un fichier Excel j'ai une liste de numéros de série.

Dans un répertoire de mon PC (C:\Devis) j'ai un tas de devis.

Je dois retrouver pour chaque numéro de série, le nom du fichier ou il apparait.

Les devis sont au format Word (docx)

J'aimerai obtenir dans la colonne B le nom du fichier où le numéro de série apparait.

Merci infiniment

Bonjour,

Je ne suis pas certain d'avoir compris. Les numéros sont bien à chercher dans le titre du document et pas dans les documents eux-mêmes ?

En supposant que c'est le cas, voici un premier essai :

Sub ChercherDevis()

Dossier = "C:\Devis\"
NB = cells(rows.count,1).end(xlup).row 'nombre de lignes en A

for i = 1 to NB 'pour chaque cellule en A
    devis = range("A" & i).value 'devis (n° série) à chercher dans dossier
    Fichier = Dir(Dossier & "*" & devis & "*") 'initialisation de la recherche de Fichier dans Dossier
    while Fichier <> "" 'tant qu'il y a des correspondances
        n = n + 1 'incrémentation de n
        Range("B" & n).value = Fichier 'copie nom fichier en B
        Range("C" & n).value = i 'copie index (sur Col A) du devis d'origine en C (en cas de multiplons)
        Fichier = Dir 'Fichier suivant
    wend
next i

End sub

Cdlt,

Hello 3GB,

Merci beaucoup pour ton aide ...

Effectivement, les numéros de série sont dans le contenu des fichiers word et non dans le titre.

Tu crois que c’est possible de faire ce type de recherche ?

Encore merci mon ami(e)

Bonjour Hedi,

Oui, c'est plus compliqué puisqu'il faut ouvrir chaque document pour chaque numéro et les inspecter. Et le problème, c'est que c'est finalement plus une problématique Word que Excel et je ne connais pas. Mais je vais quand même essayer de t'aider (j'ai fait des petites recherches spécialement pour toi) :

Sub ChercherDevis()

dim ws as worksheet
dim odoc as document
dim Dossier$, Fichier$, Chemin$
dim NB%, i%, n%

Set ws = Activesheet
Dossier = "C:\Devis\"
NB = ws.cells(rows.count,1).end(xlup).row 'nombre de lignes en A

Application.screenupdating = false

for i = 1 to NB 'pour chaque cellule en A
    devis = ws.range("A" & i).value 'devis (n° série) à chercher dans dossier
    Fichier = Dir(Dossier & "*.doc*") 'initialisation de la recherche de Fichier dans Dossier
    while Fichier <> "" 'tant qu'il y a des fichiers
        Chemin = Dossier & Fichier 'nom complet du fichier
        Documents.open filename:=Chemin, visible:=false 'ouvre doc word
        Set odoc = Activedocument 'odoc devient le doc actif
        odoc.range(0,0).select 'selection du début
        selection.moveend wdstory 'jusqu'à la fin (RISQUE D'ERREUR)
        with selection.find 'avec la sélection, on cherche
            .text = devis 'le devis
            .execute 'on applique
            if .found then 'si on trouve une correspondance
                n = n + 1 'incrémentation de n
                ws.Range("B" & n).value = Fichier 'copie nom fichier en B
                ws.Range("C" & n).value = i 'copie index (sur Col A) du devis d'origine en C (en cas de multiplons)
            end if
        end with
        odoc.close savechanges:=wdDoNotsavechanges
        Fichier = Dir 'Fichier suivant
    wend
next i

Application.screenupdating = true

End sub

Voilà, sans grande conviction car je n'ai pas essayé et que je ne maitrise pas la syntaxe donc il y a des risques importants de bugs (notamment quand je fais tout sélectionner et quand j'utilisa la méthode rechercher). Et ça risque d'être un peu long...

L'idéal serait quand même à l'avenir d'avoir un unique fichier excel servant d'interface pour éditer tes devis (et factures) en PDF, avec toutes les infos soigneusement archivées dans une base.

Cdlt,

Merci beaucoup pour ton aide ....

Malheureusement ça n'a pas l'air de fonctionner.

J'ai trouvé un autre VBA, celui-ci a l'air de s'executer mais il me renvoi n'importe quoi en colonne B.

La liste des serials doit être dans un txt.

Code en PJ

Merci ;-)

Peux-tu essayer comme ça ?

Sub ChercherDevis()

dim ws as worksheet
Dim wApp as Word.Application
dim odoc as Word.document
dim wSel as Word.selection
dim Dossier$, Fichier$, Chemin$
dim NB%, i%, n%

Set ws = Activesheet
Dossier = "C:\Devis\"
NB = ws.cells(rows.count,1).end(xlup).row 'nombre de lignes en A

Application.screenupdating = false
Set wApp = CreateApplication("Word.Application")

for i = 1 to NB 'pour chaque cellule en A
    devis = ws.range("A" & i).value 'devis (n° série) à chercher dans dossier
    Fichier = Dir(Dossier & "*.doc*") 'initialisation de la recherche de Fichier dans Dossier
    while Fichier <> "" 'tant qu'il y a des fichiers
        Chemin = Dossier & Fichier 'nom complet du fichier
        with wApp
            .visible = false
            set odoc = .Documents.open(Chemin) 'ouvre doc word
        end with
        set wSel = odoc.selection.wholestory
        with wSel.find 'avec la sélection, on cherche
            .text = devis 'le devis
            .execute 'on applique
            if .found then 'si on trouve une correspondance
                n = n + 1 'incrémentation de n
                ws.Range("B" & n).value = Fichier 'copie nom fichier en B
                ws.Range("C" & n).value = i 'copie index (sur Col A) du devis d'origine en C (en cas de multiplons)
            end if
        end with
        odoc.close savechanges:=wdDoNotsavechanges
        Fichier = Dir 'Fichier suivant
    wend
next i

wApp.Quit
Application.screenupdating = true

End sub

Set wApp = CreateApplication("Word.Application")

J'ai une erreur là-dessus

Sub or function not defined

A remplacer par :

Set wApp = CreateObject("Word.Application")

On va y arriver petit à petit (enfin je l'espère)

ça avance petit à petit :-) mdrrr

Set wSel = odoc.Selection.wholestory

Runtime error 438

Object doesn't support this property or method

:-(

D'accord, alors peux-tu essayer comme ça :

with odoc.selection.wholestory.find 'avec la sélection, on cherche

'A LA PLACE DE CES 2 LIGNES
'set wSel = odoc.selection.wholestory
'with wSel.find 'avec la sélection, on cherche

Si ça marche toujours pas :

odoc.range(0,0).select 'selection du début
selection.moveend wdstory 'jusqu'à la fin (RISQUE D'ERREUR)
with selection.find

'A LA PLACE DE CES 2 LIGNES
'set wSel = odoc.selection.wholestory
'with wSel.find 'avec la sélection, on cherche

Non rien à faire ... que des message d'erreurs

Et parfaois j'ai word qui essaie de s'ouvrir en read only

Je suis désespéré :-(

Pourtant je fais un test simple:

Un seul fichier dans c:\devis, le fichier alstom.docx

Et un seul numero de serie dans le fichier Excel SN2

Et en ajoutant la référence "Microsoft Work X.0 Object Librairy" (où X est un entier) dans Outlis/références.

Peut-être que ça pourrait changer quelque chose...

Dans la colonne file je devrais avoir Alstom.xskx puisque le numéro de série est à l'intérieur

Merci pour ton aide mon ami(e)

Amicalement

Hedi.

J'ai déjà Ajouter Microsoft ... sans succès

Je suis désolé, j'ai l'impression que je ne peux pas t'aider plus. J'ai essayé sur mon mac mais je bloque à la création de l'objet Word.Application.

Je pense qu'on y est presque, il faut juste arriver à tout sélectionner et ensuite ça devrait le faire. Peut-être qu'en exécutant au pas à pas, ça pourra être plus parlant pour toi.

Merci beaucoup en tout cas ... tu es au top !

Peut-être qu'un autre membre verra mon message ;-)