' ----------------------------------------------------------------
' Extraction des données à partir de fichier Word vers Excel
'-----------------------------------------------------------------
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
    Dim serial As String
        
    ' -- 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                        'ne pas afficher Word pendant l'exécution
    i = ws.Range("B" & Rows.Count).End(xlUp).Row + 1   '1re ligne où on va écrire les données dans le fichier Excel
    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
        
        
        WApp.Selection.Find.Execute "CZ37191HYJ"    'On trouve le texte "No Facture"
        
        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

End Sub

Function ChoisirRepertoire() As String
' -- Fonction permettant de choisir un répertoire
    Dim oRepertoire As Object
    ChoisirRepertoire = ""
    Set oRepertoire = CreateObject("Shell.Application").BrowseForFolder(0, "Choisir un répertoire", 0)
    If (Not oRepertoire Is Nothing) Then ChoisirRepertoire = oRepertoire.Items.Item.Path
    Set oRepertoire = Nothing
End Function