Archivage automatique

[azzouzze]

Bonjour,

J'ai une macro qui me recupère des champs de fichier Word et me fait un tableau ou se trouve en 1er colonne: le lien.
J'aimerai que selon une valeur dans une colonne, il me prenne le fichié associé et me le mettre dans un dossier d'archive.

voici la macro:

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

Merci d'avance