Découpage et renommage de fichiers Word à l'aide d'une macro

Bonjour,

Au travail on me demande d'éditer plusieurs centaines de lettre qui seront envoyées à nos employés.
Les lettres sont extraites d'un logiciel, mais elles sont extraites dans un seul fichier (contenant les centaines de lettres). et je suis censé les enregistrer une par une dans un fichier distinct (afin de leur envoyer par email).

Du coup je me suis dit que je pouvais automatiser tout ça, afin de ne pas passer une semaine complète à enregistrer des lettres manuellement.
J’ai donc réussi par le biais d’une macro à découper chaque lettre en un seul fichier distinct, ce qui est déjà pas mal ! Par contre il me faut maintenant soit les nommer manuellement (fastidieux vu le nombre), ou alors améliorer ma macro afin que les fichiers se renomment tout seuls en fonctions des informations contenues dans la lettre (mais là je sèche, d’autant plus que c'est la première fois que j'utilise cette fonction sous word, j'ai d'ailleurs trouvé la macro ci-dessous sur internet).

Voici ci-dessous un exemple de lettre (la lettre est la même pour les 500 destinataires, seuls les noms et certaines informations sont modifiées) :

Texte
Texte
Texte
Texte

M. NOM PRENOM
Texte
Texte

Texte texte :
Texte : Texte
Texte : Texte
Texte : Texte
Texte texte texte : Texte
Texte Texte : Affectation (en trois mots)


Texte : Titre (en 5 mots)


Texte, Texte Texte Texte

Texte Texte Texte Texte, Texte Texte Texte Texte, Texte Texte Texte Texte Texte Texte Texte Texte Texte Texte Texte Texte, Texte :



Texte : A
Texte : 01
Texte : 01




Texte Texte Texte Texte Texte Texte Texte Texte Texte Texte Texte Texte Texte Texte Texte Texte Texte Texte Texte Texte Texte Texte Texte Texte Texte Texte Texte Texte Texte Texte.

Texte Texte Texte

Texte Texte



Voici ci-dessous la macro que j’ai utilisé pour que le document soit découpé en lettres individuelles :

Sub DecoupagePageParPage()
Dim NomDocDepart As String
Dim i As Long
Dim Dossier As String, DossierSauvegarde As String
Dim NumDoc As Long, NbPages As Long
NomDocDepart = ActiveDocument.Name
Dossier = ActiveDocument.Path
DossierSauvegarde = "D:\chemin d'accès"
VerifDossier (DossierSauvegarde)
Application.ScreenUpdating = False
Application.Browser.Target = wdBrowsePage
NbPages = ActiveDocument.Content.ComputeStatistics(wdStatisticPages)
ChangeFileOpenDirectory DossierSauvegarde
For i = 1 To NbPages
ActiveDocument.Bookmarks("\page").Range.Copy
Documents.Add
Selection.Paste
NumDoc = NumDoc + 1
ActiveDocument.SaveAs FileName:=Left(NomDocDepart, Len(NomDocDepart) - 4) + _
"_" + CStr(NumDoc) + ".doc", FileFormat:=wdFormatDocument
ActiveDocument.Close
Application.Browser.Next
Next i
Application.ScreenUpdating = True
End Sub
Private Sub VerifDossier(ByVal DossierSauvegarde As String)
On Error GoTo erreur
ChDir DossierSauvegarde
Exit Sub
erreur:
If Err.Number = 76 Then
MkDir (DossierSauvegarde)
Resume Next
End If
End Sub


Avec cette macro, j'ai donc bien les 500 lettres qui s'enregistrent (découpage) une par une.

Toutefois, j'aimerai qu'au lieu de se nommer lettre 1, lettre 2, lettre 3, etc... elles se nomment automatiquement de la façon suivante :
titreen5mois - Nom prénom - Affectation - A 01 01.doc

En cherchant sur le forum j'ai trouvé ce poste :
https://forums.commentcamarche.net/forum/affich-14337837-macro-word-nommer-fichier-avec-mot-du-texte

Mais je ne sais pas du tout comment l'insérer dans ma macro initiale (je précise que c'est la première fois que j'utilise une macro word, il s'agit donc d'un monde nouveau pour moi).

Je vous remercie par avance pour votre aide.

Alexandre