' Script VBS qui supprime une page sélectionnée dans tous les fichiers d'un répertoire
 
Dim fso, oWord, f, Compteur, iPageToDelete
Set fso = CreateObject("Scripting.FileSystemObject" )
 
Set objWord = CreateObject("Word.Application" )
objWord.Visible = False
objWord.DisplayAlerts = FALSE  
 
iPageToDelete = 2
 
' Sélection du dossier ou sont stockés les fichiers
BIF_returnonlyfsdirs   = &H0001
BIF_dontgobelowdomain  = &H0002
BIF_editbox            = &H0010
BIF_validate           = &H0020
BIF_browseforcomputer  = &H1000
 
wdGoToPage         = 1
wdGoToLine         = 3
wdGoToAbsolute     = 1
wdGoToRelative     = 2
wdDoNotSaveChanges = 0
wdLine             = 5
wdParagraph        = 4
wdExtend           = 1
 
 
Dim shell, item
Set shell = WScript.CreateObject("Shell.Application" )
flag=BIF_returnonlyfsdirs  
titre="Dossier dans lequel sont stockés les fichiers Word"
Set Item = shell.BrowseForFolder(0,titre,flag, dirinit)
If isvalue(Item) Then
 Result=Item.Title
 
 ' Test si on a sélectionné la racine d'une partition  
 If InStr(1,Result,":" )=0 Then
  Result=Item.ParentFolder.ParseName(Item.Title).Path
  End If
else
 Wscript.quit
End If
 
Compteur = 0
' Traitement des fichiers Word contenus dans le répertoire sélectionné
Set f = fso.GetFolder(Result)
Set fc = f.Files
   For Each f1 in fc
      if StrComp(LCase(Right(f1.Name,4)),".doc",1 ) = 0  Then
   ' Traitement du fichier
   Set objWordFile = objWord.Documents.Open(Result + "\" + f1.Name)  
   objWord.Selection.GoTo(wdGoToPage, wdGoToAbsolute, iPageToDelete).Bookmarks("\Page" ).Range.Delete  
   objWordFile.Save()
  objWordFile.close()  
 Compteur = Compteur + 1
   End If
   Next
 
objWord.Quit  
 
MsgBox Cstr(Compteur) + " fichiers ont été traités."
'--------------------------------------------------------------
' Test de validité de l'objet retourné par BrowseForFolder
' On ne peut pas utiliser "IsObject", qui retourne toujours "true"
Function IsValue(obj)
Dim tmp
On Error Resume Next
tmp = " " & obj
If Err <> 0 Then IsValue = False Else IsValue = True
On Error GoTo 0
End Function