Import Word data to Excel

Hello,

I would like to extract some text from a word file and transfert it into an excel spreadsheet.
My text is always presented in the same way.
First there is a line with some data (see exemple bellow).
I have no problem to extract them using the macro bellow even it's not perfect.

My problem is on the main text. I weed to keep the format or at least the different paragraphes as when you copy text in word and past it in the formula bar (or press F2).

Do someone got an idea ?

Thank you for your help !

Best regard,

A.

Here is an exemple of my word file

Code : XXX1- Abrégé : DGS45 - Type : D - ADICAP : PHXT5847

TITRE

Text Paragraph 1

Text Paragraph 2

...

Text Paragraph n
CONCLUSION


Code : LOIEIE5- Abrégé : LMFIE86- Type : V - ADICAP : LEJQ6347

TITRE 2

Text Paragraph A

Text Paragraph C

...

Text Paragraph i
CONCLUSION 2

And so one for 250 pages

Here is my macro

Sub Importation_Donnees_Word()

' -- Déclaration des variables
Dim wb As Workbook 'classeur Excel dans lequel on importe les données
Dim ws As Worksheet 'onglet Excel dans lequel on importe les données
Dim sChemin As String 'répertoire contenant les fichiers Word
Dim sNomFichier As String 'nom du fichier Word
Dim WApp As Object, WDoc As Object, WSel As Object
Dim i As Integer

' -- Initialisation des variables
Set wb = ThisWorkbook
Set ws = wb.Sheets(1) 'on sauvegarde dans la 1re feuille
sChemin = ChoisirRepertoire & "\" 'fonction pour choisir le répertoire contenant les fichier Word
'sChemin = ThisWorkbook.Path & "\" 'si les fichiers Word se trouvent dans le même répertoire que le fichier Excel
sNomFichier = Dir(sChemin & "*.doc*") 'pour ouvrir tous les fichiers .doc*. 1er fichier.

Set WApp = CreateObject("Word.Application") 'pour créer un objet Word
WApp.Visible = True
i = ws.Range("A" & Rows.Count).End(xlUp).Row + 1

Application.ScreenUpdating = False

' -- Boucle sur les fichiers
Do While Len(sNomFichier) > 0

Set WDoc = WApp.Documents.Open(sChemin & sNomFichier) 'ouvre le document Word
Application.StatusBar = "Écriture ligne " & i 'message dans Excel pour voir la progression

' Nom du fichier
ws.Cells(i, 1) = sNomFichier

' No de facture (par la fonction FIND)
WApp.Selection.HomeKey Unit:=6 'Retourne au début du fichier Word
WApp.Selection.Find.ClearFormatting 'on "vide la mémoire" de la fonction Recherche
WApp.Selection.Find.Execute "N° Facture" 'On trouve le texte "No Facture"
WApp.Selection.MoveRight Unit:=3, Count:=2, Extend:=1 'On se déplace de 3 mots
Set WSel = WApp.Selection 'sélection du texte trouvé
ws.Cells(i, 2) = Trim(Split(WSel, ":")(1)) 'Le No de facture est la 2e chaîne de caractères séparés par 2 ":"


' Nom du client (par la fonction FIND)
WApp.Selection.HomeKey Unit:=6
WApp.Selection.Find.ClearFormatting
WApp.Selection.Find.Execute "ADICAP :"
WApp.Selection.MoveRight Unit:=3, Count:=2, Extend:=1
Set WSel = WApp.Selection
ws.Cells(i, 3) = Split(WSel, ":")(1)

' Nom du client (par la fonction FIND)
WApp.Selection.HomeKey Unit:=6
WApp.Selection.Find.ClearFormatting
WApp.Selection.Find.Execute "ADICAP :"
WApp.Selection.MoveDown Unit:=wdParagraph, Count:=30, Extend:=wdExtend
Set WSel = WApp.Selection
ws.Cells(i, 4).Activate
SendKeys "{F2}"
ActiveCell.FormulaR1C1 = WSel



i = i + 1 'prochaine ligne
WDoc.Close False 'fermer le document Word sans enregistrer
sNomFichier = Dir 'prochain document
Loop

SortieNormale:
Application.ScreenUpdating = True
WApp.Quit 'Fermer l'instance de Word
Application.StatusBar = False 'Remise à zéro de la barre d'état

Hi Alphafrog,

Thank you very much for your reply !

If I understand well, I need to enter convert my word file into différents filled form.
Then I have to transfert the Active-X textbox form word to excel.

Sorry but I don't really see how to convert my word file into a filled form.

Could you tell me ?

Best regards,

A.

Thank you !

I will try !

Best regards,

A.