Ahoj,
tak předkládám výsledek.
Má to několik komplikací.
1. nepovedlo se mi přijít na způsob, jak najít text. Skript tedy prohledává wordovské soubory na přítomnost slova. Celý text wordu tedy srovnává po slovech, takže nelze k vyhledání použít např. větu. Hledané slovo lze zvolit v položce
Const najdi = "počítač" (hledané slovo počítač je v uvozovkách).
2. nelze zadat počet znaků. Nicméně lze zvolit počet slov za nalezeným slovem.
Const nasled = 3 (zapíše hledané slovo + 3 následující slova)
3. cestu ke složce s umístěnými soubory lze zadat v
Const slozka = "C:\test" (cesta je uvedena včetně písmena disku v uvozovkách.
Musí být bez mezer!4. skript vytvoří soubor
vysledek.doc Jméno výsledného souboru lze změnit v
objDoc.SaveAs("C:\test\vysledek.doc") (jméno souboru i s cestou v uvozovkách. Adresář (zde test) musí existovat a nesmí v jeho názvu být mezera.
5. Ve složce musí být pouze dokumenty wordu, jinak skript skončí chybou.
6. Jednotlivé nálezy jsou odděleny mezerou (5x odentrovány)
7. Pokud je hledané slovo i v těch dalších (zde třech) je ignorováno
8. Prohledávání dost dlouho trvá. Ukončení práce skript oznámí oznámením "Skript ukončil práci" (okno Wscript host).
Postup:Uvedený text v Code si označ a zkopíruj Ctrl+C. Otevři notepad (poznámkový blok) a vlož Ctrl+V. Ulož s příponou .vbs. (Nebo ulož jako text a pak třeba v totalcommanderu přejmenuj).
Nepoužívat textové editory jako word, wordpad a podobně!!!. V notepadu si můžeš rovnou zeditovat potřebné vlastnosti (cestu, hledané slovo, výsledný soubor, počet slov za hledaným slovem).
Soubor spustíš poklepáním na ikonu souboru.
Kód: Vybrat vše
'*******************************************************
'* Skript testuje word soubory na zvolené slovo *
'* Pokud slovo najde, vytvoří dokument vysledek *
'*V dokumentu zapíše hledané slovo + určený počet slov *
'* *
'* Vytvořeno pro PC-HELP *
'* *
'* Etienn@Script v 1.0 *
'*******************************************************
Option Explicit
Rem the Word Application
Dim objWord, wordPath, objDoc, objSelection
Rem the document we are currently reading data from
Dim currentDocument
Rem the number of Words in the current document
Dim numberOfWords
Dim i, k, n, y, x, slovo
Dim Textw, fso, oFolder, oFiles, wsh
Const slozka = "C:\test\" 'Složka s word soubory
Const najdi = "počítač" 'Hledané slovo
Const nasled = 3 'Počet slov zkopírovaných za hledaným slovem
Set wsh = WScript.CreateObject("WScript.Shell")
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Set oFolder = fso.GetFolder(wsh.ExpandEnvironmentStrings(slozka)) 'objekt složky
Set oFiles = oFolder.Files ' Objekt seznamu souborů ve složce
Textw = ""
' Kolekce souborů ve složce
For Each k In oFiles
wordPath = slozka & k.Name
Rem Create an invisible version of Microsoft Word
Set objWord = CreateObject("Word.Application")
Rem don't display any messages about documents needing to be converted
Rem from old Word file formats
objWord.DisplayAlerts = 0
Rem open the Word document as read-only
Rem open (path, confirmconversions, readonly
objWord.Documents.Open wordPath, false, true
Rem Access the document
Set currentDocument = objWord.Documents(1)
Rem How many words are in the document
NumberOfWords = currentDocument.Words.count
For i = 1 To numberOfWords
y = StrComp (currentDocument.Words(i), najdi)
x = StrComp (currentDocument.Words(i), najdi & " ")
If y = 0 Or x = 0 Then
For n = 0 To nasled
Textw = Textw & currentDocument.Words(i + n)
'WScript.Echo "i+n= " & i + n & vbcrlf & "Textw ve smyčce= " & Textw
Next
Textw = Textw & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf
i = i + nasled
End If
Next
Rem Close the document
currentDocument.Close
Rem Free memory used to store the document object
Set currentDocument = Nothing
Rem exit Microsoft Word
objWord.Quit
Set objWord = Nothing
Next
'vytvoření souboru a zápis
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection
objSelection.Font.Name = "Arial"
objSelection.Font.Size = "12"
objSelection.TypeText Textw
objSelection.TypeParagraph()
objDoc.SaveAs("C:\test\vysledek.doc")
objDoc.Close
objWord.Quit
Set objWord = Nothing
WScript.Echo "Skript ukončil práci"
). 
