Find string: if 2 hits in document -> then write to a new document path of that doc.

[Cubajz]

Hi, I was wondering if anyone can help me with this "little" macro, thx for any help.
I have multiple files in multiple folders and I need to check if there are these strings :
1.: "Zákaz práce na pozemních komunikacích"
2.: "Zákaz práce na pozemní komunikaci"

If either of these strings exists in document TWO TIMES (two hits in find option window) -> I want macro to write into a new window (document) path of that specific document (I mean for example C:\Users\James...)

Thanks for any help!

[excelliot]

Files which you are searching are excel or word?


Cheers!!
excelliot.com

[Cubajz]

Word, sry for not specifing that!

[excelliot]

try this code:

Sub BackupMyFiles()
Dim i, n  As Integer
   
Application.ScreenUpdating = False
Application.DisplayAlerts = wdAlertsNone


vDirectory = "C:\test\" 'change main directory
vFile = Dir(vDirectory & "\" & "*.do*")
bDirectory = "C:\test\bkup\" '<<< change backup directory


Do While vFile <> ""
Documents.Open FileName:=vDirectory & "\" & vFile
i = 0: n = 0


With ActiveDocument.Content.Find
Do While .Execute(FindText:="Zákaz práce na pozemních komunikacích", Forward:=True, Format:=True, _
   MatchWholeWord:=True) = True
   i = i + 1
Loop


Selection.HomeKey Unit:=wdStory


Do While .Execute(FindText:="Zákaz práce na pozemní komunikaci", Forward:=True, Format:=True, _
   MatchWholeWord:=True) = True
   n = n + 1
Loop


End With
    
ActiveDocument.Close 0


If i > 1 Or n > 1 Then
FileCopy vDirectory & "\" & vFile, bDirectory & "\" & vFile
End If


vFile = Dir
Loop


Application.ScreenUpdating = True
Application.DisplayAlerts = wdAlertsAll


MsgBox "Done.."
End Sub

change location of main directory & backup directory..

Cheers!!
excelliot.com