Sub récup_champs_word()
Dim Repertoire As String
Dim Tablo
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim i%, ii%, debut%
Dim Rep%
On Error GoTo GestErr
Repertoire = F_GetOpenFolder ' choix du répertoire
Tablo = F_ListFilesInFolder(Repertoire, False, msoFileTypeWordDocuments)
If Rep = 7 Then Exit Sub
If Not IsArray(Tablo) Then Exit Sub
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = False
debut = ii 'juste pour les calculs de fin
' boucle de recupération des champs des fichiers
' Word dans le dossier spécifié
For i = 0 To UBound(Tablo) - 1
Set WordDoc = WordApp.Documents.Open(Tablo(i), ReadOnly:=False)
With WordDoc
If Not Left(.Name, 1) = "~" Then ' ne récupère pas les temporaires, sinon bug
' écriture dans la feuille xl active
Cells(ii, 1) = .Name
ActiveSheet.Hyperlinks.Add Anchor:=Cells(ii, 1), Address:=Tablo(i)
Cells(ii, 24) = .FormFields("Nom").Result
ii = ii + 1
End If
.Close
End With
Next i
Set WordDoc = Nothing
Set WordApp = Nothing
MsgBox "Opération terminée, " & ii - debut + 1 & " fichiers récupérés"
Exit Sub
GestErr:
'MsgBox Err.Number & " " & Err.Description
Resume Next
'Set WordDoc = Nothing
'Set WordApp = Nothing
End Sub
