Bonjour à tous,

j'ai un petit souci dans ma macro qui fait la chose suivante :
- Parcourt le contenu d'un répertoire de fichier .doc
- ouvre les .doc 1 après l'autre
- effectue une copie du contenu
- et au final colle la total dans un autre fichier word

Etant donné que application.FileSearch ne fonctionne plus à partir de la v2007, j'utilise Dir() pour effectuer le parcourt.

Voici mon code
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
Sub MonExemple()
Dim FichierEnCours, FichierCourant, FichierEnCoursComplet
Dim FichierTmpName, NewDocName
Dim NewDoc As Boolean
Dim Wrd As Object
 
' Renvoie le nom de fichier .doc trouvé et si plusieurs fichiers existent dans le repertoire, le premier fichier trouvé est renvoyé.
FichierEnCours = Dir("c:/essai/*.doc")
Do While Len(FichierEnCours) > 0
    MsgBox FichierEnCours
    ' suppression temporaire de l'update automatique des links (évite l'apparition d'un warning message à chaque ouverture d'un fichier doc)
    Options.UpdateLinksAtOpen = False
    ' ouverture du fichier sans le rendre visible
    FichierEnCoursComplet = "c:/essai/" & FichierEnCours
    Documents.Open Filename:=FichierEnCoursComplet, Visible:=True, _
                ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _
                PasswordDocument:="", PasswordTemplate:="", Revert:=False, _
                WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _
                wdOpenFormatAuto
 
    FichierCourant = ActiveDocument.Name
    If Not NewDoc Then 'Je ne crée un nouveau document au modèle que s'il n'existe pas
       'Créer et ouvrir un document en utilisant le modèle attaché au document actif
        FichierTmpName = ActiveDocument.AttachedTemplate.FullName
        Documents.Add Template:=FichierTmpName, NewTemplate:=True
        NewDocName = ActiveDocument.Name
        NewDoc = True ' On ne passe ici qu'une fois
    End If
 
    'Retour dans le document à copier
    Documents(FichierCourant).Activate
 
' CODE NE FONCTIONNE PAS, REMPLACÉ par GetObject *********            
    'Sélection de tout le document à copier
    'Selection.WholeStory         
    'Copie de toutes les données
    'Selection.Copy
 
'CODE DE REMPLACEMENT
    Set Wrd = GetObject(, "word.Application")
    Wrd.ActiveDocument.Select
    Wrd.Selection.WholeStory
    Wrd.Selection.Copy
 
 
    'Retour dans le nouveau document
    Documents(NewDocName).Activate
 
    'Colle toutes les données sauvegardées dans le document compilé
    Wrd.Selection.Paste
 
    'Fermeture du document (copié) sans sauvegarde
    Documents(FichierCourant).Close (wdDoNotSaveChanges)
 
    'On va en fin du doc créé pour être en position de recevoir la nouvelle copie
    Wrd.Selection.EndKey Unit:=wdLine
 
    'Réactivation de l'option update automatique des liens
    Options.UpdateLinksAtOpen = True
 
    ' Appelle de nouveau Dir sans argument pour renvoyer le fichier *.doc suivant dans le même dossier.
   FichierEnCours = Dir
Loop
 
'Mise à jour général de toutes les données linkées
Documents.Open Filename:=ThisWorkbook.path & "\MonFichierGlobal.doc", ConfirmConversions:=False _
            , ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
            PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
            WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:=""
ActiveDocument.Content.Select
Wrd.Selection.Fields.Update
 
End Sub
Il ne se passe rien et mon fichier "MonFichierGlobal.doc" est desesperement vide

Que fais je de mal????

Merci pour vos lumières

++