Vbscript finds text within web page

Expert Exchange Expert "Shift-3" helped me with the code below. It's basically searching for a word within a web page. http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_23871363.html

Everything works great, but I need help with editing the code to find an "exact match" within the webpage.

e.g.

 If I'm searching for "fox"

 "Firefox" or "foxy" would be considered unsuccessful.



Const ForReading = 1
Const ForWriting = 2
Const TriStateUseDefault = -2
 
On Error Resume Next
 
strWordList = "C:\Words2Search.txt"
strErrorLog = "C:\Failed to Find.txt"
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objWordList = objFSO.OpenTextFile(strWordList, ForReading, False, TriStateUseDefault)
arrWords = Split(objWordList.ReadAll, vbCrLf)
objWordList.Close
 
Set objErrorLog = objFSO.OpenTextFile(strErrorLog, ForWriting, True)
 
Set objShell = CreateObject("Shell.Application")
Set objShellWindows = objShell.Windows
 
For i = 0 to objShellWindows.Count - 1
    Set objIE = objShellWindows.Item(i)
    strURL = objIE.LocationURL
    If Left(strURL, 4) = "http" Then
        strText = objIE.document.body.innerText
        
        For Each strWord in arrWords
            If InStr(1, strText, strWord, vbTextCompare) = 0 Then
                objErrorLog.WriteLine strWord
            End If
        Next
    End If
Next
 
objErrorLog.Close

Open in new window

abgtempAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Shift-3Commented:
That does make it a little trickier.

This revision should only find words which are not preceded or followed by letters or numbers.  It will still find ones adjacent to symbols.


Const ForReading = 1
Const ForWriting = 2
Const TriStateUseDefault = -2
 
On Error Resume Next
 
strWordList = "C:\Words2Search.txt"
strErrorLog = "C:\Failed to Find.txt"
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objWordList = objFSO.OpenTextFile(strWordList, ForReading, False, TriStateUseDefault)
arrWords = Split(objWordList.ReadAll, vbCrLf)
objWordList.Close
 
Set objErrorLog = objFSO.OpenTextFile(strErrorLog, ForWriting, True)
 
Set objShell = CreateObject("Shell.Application")
Set objShellWindows = objShell.Windows
 
For i = 0 to objShellWindows.Count - 1
    Set objIE = objShellWindows.Item(i)
    strURL = objIE.LocationURL
    If Left(strURL, 4) = "http" Then
        strText = objIE.document.body.innerText
        
        For Each strWord in arrWords
            If Not ExactMatch(1, strText, strWord) Then
                objErrorLog.WriteLine strWord
            End If
        Next
    End If
Next
 
objErrorLog.Close
 
Function ExactMatch(intStart, strText, strToFind)
    intPos = InStr(intStart, strText, strToFind, vbTextCompare)
    If intPos <> 0 Then
        If intPos > 1 Then
            strBefore = Mid(strText, intPos - 1, 1)                
            If IsNumeric(strBefore) Or UCase(strBefore) <> LCase(strBefore) Then
                blnBad = True
            End If
        End If
        
        If (intPos + Len(strToFind)) < Len(strText) Then
            strAfter = Mid(strText, intPos + Len(strToFind), 1)                
            If IsNumeric(strAfter) Or UCase(strAfter) <> LCase(strAfter) Then
                blnBad = True
            End If
        End If
        
        If Not blnBad Then
            ExactMatch = True
        Else
            Call ExactMatch(intPos + 1, strText, strToFind)
        End If
    End If
End Function

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
abgtempAuthor Commented:
Hey Shift-3,

                    Thanks for the updated code.  I think I may have came up with a way to cover all bases.  I'm just adding a "space" behind the word. I also added a 'comma' just in case the word is listed in a series. I'm still giving you extra points because of your time spent on this and still I'm happy with the result of the original code.


For i = 0 to objShellWindows.Count - 1
    Set objIE = objShellWindows.Item(i)
    strURL = objIE.LocationURL
    If Left(strURL, 4) = "http" Then
        strText = objIE.document.body.innerText
        
        For Each strWord in arrWords
         strWord1 = strWord & " "              'Adds space behind word
         strWord2 = strWord & ","              'Adds comma behind word
 
 
         Match1 = InStr(1, strText, strWord1, vbTextCompare)
         Match2 = InStr(1, strText, strWord2, vbTextCompare)	
 
 
	If Match1 = 0 And Match2 = 0 Then
          objErrorLog.WriteLine strWord
            End If
        Next
    End If
Next
 
objErrorLog.Close

Open in new window

0
abgtempAuthor Commented:
Could you please help me with this open question that I have. Thanks
http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_23874454.html
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.