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