modifier boite dialogue et supprimer fichier apres fin execution macro

Bonjour,

Après avoir trouvé ce code et adapté en partie à mes besoins je rencontre des problemes du à mon niveau en vba à finir son adaptation.
Je precise je suis en excel2007.
pour le moment la macro ouvre une boite de dialogue et une fois trouver le dossier ouvre le premier fichier word hors, je souhaiterais que quand j'excute ma macro , la boite de dialogue s'ouvre sur le dossier contenant mes fichiers Word et que je puisse selectionner le fichier à traiter et une fois traiter le fichier soit supprimé.
voici mon code :

Option Explicit

' ----------------------------------------------------------------
' 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

' -- 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 = False 'ne pas afficher Word pendant l'exécution

Application.ScreenUpdating = False


Set WDoc = WApp.Documents.Open(sChemin & sNomFichier) 'ouvre le document Word


' Nom ou raison sociale (par la fonction FIND)
WApp.Selection.HomeKey unit:=6
WApp.Selection.Find.ClearFormatting
WApp.Selection.Find.Execute "NOM :"
WApp.Selection.MoveLeft unit:=wdWord, Count:=9, Extend:=4
Set WSel = WApp.Selection
ws.Range("B3") = Trim(Split(WSel, "l'installation")(1))

' adresse (par la fonction FIND)
WApp.Selection.HomeKey unit:=6
WApp.Selection.Find.ClearFormatting
WApp.Selection.Find.Execute "Adresse 1 :"
WApp.Selection.MoveLeft unit:=wdWord, Count:=12, Extend:=4
Set WSel = WApp.Selection
ws.Range("B4") = Trim(Split(WSel, "comptage")(1))



WDoc.Close False 'fermer le document Word sans enregistrer

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


Merci d'avance