Traitement de plusieurs fichiers Word en simultané par une macro Excel

Version imprimable

30/07/2008, 16h14
Dryanide

Traitement de plusieurs fichiers Word en simultané par une macro Excel

Bonjour le forum !

Je suis nouvelle ici, et débutante en VBA sous Excel. C'est pourquoi je me tourne vers vous pour un problème qui m'empêche d'avancer depuis quelques jours. J'avais déjà posté ici, mais avec le problème qu'a connu le serveur, mon post a malheureusement été supprimé.
Je vous explique donc le souci :

J'ai créé un formulaire sous Word qui doit servir à récolter des informations auprès de nombreuses personnes. Ces personnes me renvoient donc le formulaire rempli. J'ai créé une macro sous Excel afin de récupérer les données dans les champs, et regrouper toutes les réponses dans une feuille Excel de synthèse. Une autre macro trie le tableau et supprime les doublons.
Jusque là, rien de bien méchant.

Là où se situe le problème, c'est le nombre de formulaires à traiter. En effet, j'en ai un nombre assez conséquent contenus dans un même dossier. Pour l'instant ma macro ne permet d'en traiter qu'un à la fois. J'aimerais pouvoir traiter simultanément tous les fichier du dossier.
Est-ce possible ? Si effectivement c'est le cas, pourriez-vous m'aiguiller ?

J'ai une autre question, même si j'ai des gros doutes sur la réponse que vous pourrez m'apporter. Est-il possible qu'une mise à jour "automatique" se fasse ? Je m'explique : je voudrais que si je change un champ d'un des formulaires, ce changement se répercute automatique dans la feuille Excel (à son ouverture par exemple). Là encore, si c'est possible (même si je ne me fais pas trop d'illusions...) ça serait vraiment aimable de pouvoir m'aider !

En tout cas, merci beaucoup d'avance !

En fait tu ne traites pas "simultanément" les fichiers Word, mais un par un, séquentiellement, dans une boucle de parcours. En gros l'algo serait :

(en assumant que le fichier XLS se trouve dans le même répertoire que les DOC)
Code:

1 2 3 4 5 6 7 8 9 Rechercher dans ce répertoire tous les fichiers "*.doc" Pour chaque fichier trouvé lire les valeurs du formulaire (les ranger dans un type utilisateur par ex.) rechercher si une ligne avec ces données existe déjà ((mettons que l'identifiant soit le nom) ' on obtient un numéro de ligne positif ou nul) Si le numéro de ligne = 0 alors ' nouvelle ligne ajouter une ligne dans la feuille Excel, récupérer le n° de cette ligne Finsi renseigner les cellules de la ligne trouvée par les valeurs lues Fin pour
Tu peux mettre le traitement dans une fonction ou une procédure que tu appeleras à la demande (clic de bouton, ouverture du classeur...) mais ça peut prendre du temps d'analyser tous les fichiers.

30/07/2008, 16h38
Dryanide

Merci pour ta réponse rapide Laestic :)
Quelle est la fonction qui permet donc de rechercher dans le répertoire tous les fichiers "*.doc" ?
Pour l'instant, ma macro me permet de chercher le fichier que je veux. Mais quelle fonction je dois utiliser pour ce que tu viens de m'indiquer ?

Merci en tout cas !!! :D

Re-Bonjour le forum,

J'ai suivi les indications de Laestic. J'ai le code suivant :

Code:

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
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
'Déclaration des variables utilisable dans tout le programme
Dim FileToOpen          'variable contenant le nom du fichier parcouru
Dim MyDoc As Word.Document
Dim Dossier As String   'variable pour récupérer le nom du dossier contenant les FFT
Dim WordApp As New Word.Application  'variable pour l'ouverture de l'application Word
 
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
 
'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
 
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
 
Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(Msg) Then
bInfo.lpszTitle = "Choisissez un dossier de destination pour les sauvegardes."
Else
bInfo.lpszTitle = Msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
'Dossier = GetDirectory & ""
Dossier = GetDirectory
Else
GetDirectory = ""
End If
End Function
 
'Programme de copie des données
Sub Importer()
 
    'On demande à l'utilisateur l'emplacement du dossier
    Dossier = GetDirectory
    'petites vérif sur le dossier
    If Len(Dossier) > 3 Then
        Dossier = Dossier & "\"
    End If
    If Dossier = "" Then
        MsgBox "Pas de dossier sélectionné"
        Exit Sub
    End If
 
    'obtient le premier fichier ou répertoire qui est dans "Dossier"
    FileToOpen = Dir(Dossier)
    'boucle tant que le répertoire n'a pas été entièrement parcouru
    Do While (FileToOpen <> "")
        If FileToOpen = False Then
            Exit Sub
 
        'On vérifie si le fichier entrant dans la boucle est un .doc
        ElseIf (Right$(FileToOpen, 4) = ".doc") Then
 
            'Ouvre le document Word
            Set MyDoc = WordApp.Documents.Open(FileToOpen)
 
            If MyDoc.ProtectionType <> wdNoProtection Then
                MyDoc.Unprotect Password:=""       'retire la protection du document
            End If
            Application.ScreenUpdating = False  'l'ouverture du document Word est masquée
            WordApp.Visible = False    'Word est masqué pendant l'opération
        End If
 
'[Blabla du reste du code pour récupérer les infos que je cherche]
 
    'on passe à l'élément suivant du répertoire
    FileToOpen = Dir
    Loop
 
End Sub

Mais je rencontre une erreur dès qu'on arrive à:

Code:

1
2
'Ouvre le document Word
Set MyDoc = WordApp.Documents.Open(FileToOpen)

Le compilateur m'affiche :

Citation:

Erreur d'exécution "5174":

Fichier introuvable.
Essayez les opérations suivantes :
* Vérifiez l'orthographe du nom du document.
* Utilisez un nom de document différent.
(FFT 1.doc)

Mes fichiers sont nommés ainsi : "FFT 1", "FFT 2" etc.
J'ai tenté de changer les noms, en supprimant les espaces, mais le compilateur m'affiche quand même la même erreur.

Quelqu'un pourrait m'expliquer ce qui ne va pas ? Ca serait vraiment aimable, c'est assez important et un peu urgent quand même.

Merci beaucoup d'avances pour vos réponses ! :)

31/07/2008, 13h53
Dryanide
En fait, j'ai trouvé où était l'erreur :yaisse2: Je poste la correction pour ceux qui en aurait éventuellement besoin.
L'erreur se situe bien là où on me signalait un bug. Au lieu de :
Code:

1 2 'Ouvre le document Word Set MyDoc = WordApp.Documents.Open(FileToOpen)
Il faut écrire:
Code:

1 2 'Ouvre le document Word Set MyDoc = WordApp.Documents.Open(Dossier & FileToOpen)
Evidemment, j'oubliais de spécifier le dossier.
Voili voilou. Je vais donc clore ce topic, étant donné que je doute fortement recevoir des réponses pour le deuxième problème qui m'embêtait.
24/09/2019, 13h53
eddyboss2012

Code:

Set MyDoc = WordApp.Documents.Open(Dossier & FileToOpen)

GGrand merci car cela fait 3 jours que je buttais là-dessus !!

MERCI !!:D:D:D:D