Using VBScript - Want to parse txt( or other ) file and loop until done in VBS file.

Hi Stephen,

You could try adding the words to an array, and just loop through that. Here is an example for you, I have also coded the part to read each word/phrase from each line in a text file, but commented it out in case you want to stick with the array:


 Dim words(), word

' Dim FlNum As Integer, badWordFile As String, inpTxt As String, i As Long
' badWordFile = "C:\foldername\filename.txt"
' i = 0
' FlNum = FreeFile()
' Open badWordFile For Input As #FlNum
' Do Until EOF(FlNum)
'  Line Input #FlNum, inpTxt
'  ReDim Preserve words(i)
'  words(i) = inpTxt
'  i = i + 1
' Loop
' Close #FlNum

 words = Array("joke", "virus", "a phrase", "yet another")
 
 For Each word In words
  If UCase(Msgobj.htmlbody) Like "*" & UCase(word) & "*" Then
   'forward email
   Exit For
  End If
 Next


Let me know if you have any questions
Matt

Hi Matt, ive used the array and this works fine...  but cant see where I would forward email in your 1st example...

( to fwd email ifound=1) so Im using

      words = Array("joke", "virus", "a phrase", "mighty stuff")
       For Each word In words
        If UCase(Msgobj.htmlbody) Like "*" & UCase(word) & "*" Then
       ifound=1
         Exit For
        End If
       Next

thanks!

Oh , hang on I would use....(without comment outs)

' Dim FlNum As Integer, badWordFile As String, inpTxt As String, i As Long
' badWordFile = "C:\foldername\filename.txt"
' i = 0
' FlNum = FreeFile()
' Open badWordFile For Input As #FlNum
' Do Until EOF(FlNum)
'  Line Input #FlNum, inpTxt
'  ReDim Preserve words(i)
'  words(i) = inpTxt
'  i = i + 1
iFound = Instr(1, words, inpTxt, 1) ************I add this line?
' Loop
' Close #FlNum
Would that be right?

I am a bit confused by your question, but I think I got it.

If you have something that says 'if iFound>0 then forward email' then you could just put

 For Each word In words
  If UCase(Msgobj.htmlbody) Like "*" & UCase(word) & "*" Then iFound = 1: Exit For
 Next

That would work whether you use the hard-coded array technique or the text-file array technique.  No need to use InStr, as the Like operator will only return true if the word is in the message body.

If I missed your point, I apologize.

If you are using the coded array, all you would need is:

 Dim words(), word

 words = Array("joke", "virus", "a phrase", "yet another")
 For Each word In words
  If UCase(Msgobj.htmlbody) Like "*" & UCase(word) & "*" Then iFound = 1: Exit For
 Next

Matt

Thanks Matt....

Just a little confused mysefl :-) If I want to use a text file... where would i place :

 For Each word In words
  If UCase(Msgobj.htmlbody) Like "*" & UCase(word) & "*" Then iFound = 1: Exit For
 Next

Cheers!

Not a problem at all! The commented code would substitute the "words=array(..." line. Here would be the code you need for the textfile method:

 Dim words(), word
 Dim FlNum As Integer, badWordFile As String, inpTxt As String, i As Long
 badWordFile = "C:\foldername\filename.txt"
 i = 0
 FlNum = FreeFile()
 Open badWordFile For Input As #FlNum
 Do Until EOF(FlNum)
  Line Input #FlNum, inpTxt
  ReDim Preserve words(i)
  words(i) = inpTxt
  i = i + 1
 Loop
 Close #FlNum

 For Each word In words
  If UCase(Msgobj.htmlbody) Like "*" & UCase(word) & "*" Then iFound = 1: Exit For
 Next


If you're going to be doing this to multiple emails, you may want to take the first part (that takes the words out of the file), place that into the calling procedure first, and just pass that to the checking/email procedure, so you don't have to open the text file with each message you're checking.

So I stick this in the middle of my code before if ifound=1 then send email?

 Dim FlNum As Integer, badWordFile As String, inpTxt As String, i As Long
 badWordFile = "C:\evtsink\words.txt"
 i = 0
 FlNum = FreeFile()
 Open badWordFile For Input As #FlNum
 Do Until EOF(FlNum)
  Line Input #FlNum, inpTxt
  ReDim Preserve words(i)
  words(i) = inpTxt
  i = i + 1
 Loop
 Close #FlNum

 For Each word In words
  If UCase(Msgobj.htmlbody) Like "*" & UCase(word) & "*" Then iFound = 1: Exit For
 Next

Probably.. Is this going in a function or something, where you send the Msgobj to? If so, I would put the part that opens the badwordfile and fills the words array in the sub that calls the function, and pass the words array to the function along with Msgobj. But if the msgobj is declared in this sub then its perfect the way it is.

It only takes a split second to populate the words array, so its probably not a big savings anyways, but if you're going to be reviewing thousands of emails at once, it could save a bit.

Sorry for bothering you Matt! Getting into difficulty with reading from txt file.... word array works fine though :-)

What im doing is using Exchange event sink onsave to call the vbs which checks for text and forwards to HR if contains certain keywords.
This script runs every time a mail is sent by one user to the other .

Im using this exactly but gives errors even on the Dims... do i need to use something like Option Explicit ?

Thanks for all your help!

Hi Stephen

It's not a bother, I'm glad to help.  Option Explicit isn't required, and all that does is make sure you have all your variables Dim'med.  I don't know why you'd be getting errors, though, especially on the dim statements.  You put the Sub subname() and End Sub around the text?  If so, what is the error you're getting?

Matt

Hi Matt ,
im not actually getting an error .. just that it doesnt pick up any of the mails....

will have a look again... :)

Hi Matt , if i post my code here , could you have a look , will increase points :)

Sure thing, I'll help any way I can

Ok , thanks Matt!

************************************************************
This works...
 words = Array("joke", "virus", "a phrase", "yet another")
 
 For Each word In words
  'If "Msgobj.htmlbody" Like "*" & word & "*" Then
      iFound = Instr(1, ucase(Msgobj.htmlbody),ucase(word), 1)
  exit For
  'End If
 Next

************************************************************
Once i uncomment the line :

 Dim FlNum As Integer, badWordFile As String, inpTxt As String, i As Long

The script stops....

Changed to

Dim FlNum  
Dim badWordFile
Dim inpTxt
Dim i

it doesnt stop

(Now i start uncommenting the code that reads the txt file.....)

Dim FlNum  
Dim badWordFile
Dim inpTxt
Dim i
badWordFile = "C:\evtsink\words.txt"
i = 0
FlNum = FreeFile()
Open badWordFile For Input As #FlNum' Do Until EOF(FlNum)
Line Input #FlNum, inpTxt
ReDim Preserve words(i)
words(i) = inpTxt
i = i + 1
Loop
Close #FlNum

 
 
 For Each word In words
  'If "Msgobj.htmlbody" Like "*" & word & "*" Then
      iFound = Instr(1, ucase(Msgobj.htmlbody),ucase(word), 1)
  exit For
  'End If
 Next

Stops the code....

Should the "For each word in Words " not be in the middle of the loop above that reads from txt file?

Cheers!!

******************************************************

Running the script manually bombs out at the line:

Open badWordFile For Input As #FlNum

checked the code and added the line which i had missing but makes no difference...

I had "Open badWordFile For Input As #FlNum' Do Until EOF(FlNum)"

Changed to
Open badWordFile For Input As #FlNum
Do Until EOF(FlNum)

Same difference though....

Error it gives me manually is "expected end of statement.."

I checked http://www.cpcug.org/user/clemenzi/technical/Languages/VisualBasic/VBFileIO.htm#Open 

and the code you have is spot on... Maybe its something to do with VB versus VBS?

this line still causes trouble "Open badWordFile For Input As #FlNum"

cheers!

Hi Matt , can you have a quick look if you can , thanks!

Hi Stephen

I am sorry about this delay! I've had a VERY busy and eventful past few days, and I truly apologize for not getting back to you on this sooner.  In the end, I have a brand new laptop (though I had to spend a good portion of my christmas money on it) and now I can go back to checking my email and EE!

To be perfectly honest I don't know why that line is causing a problem.  Its possible that either badWordFile or FlNum is not allowed in the program you're using, you may want to try changing those variable names to see if that's causing the issue.

You could also try it with some optional arguments added, like:
 Open badWordFile For Input Access Read As #FlNum
or
 Open badWordFile For Input Access Read Shared As #FlNum

Try changing the names or one of those two lines, see if it fixes the error for you.  If not, let me know, and I'll see what I can dig up that might help. As of now though, I really don't know what else it could be.

Again, sorry for the delay!
Matt

Sorry Matt , wasnt trying to annoy you , just wrecking my head :-)

will try this and let you know! :)

Could it be something to do with VBS....versus VB?

Im using VBS with the following in a vbs file...

It gives me again an "Expected End of Statement" at line 4 character 18.. cant see what it is :-( Seems to be at the "For"....

badWordFile = "c:\evtsink\words.txt"
i = 0
FlNum = Freefile
Open badWordFile For Input Access Read As #FlNum
Do While not EOF(FlNum)
Line Input #FlNum, inpTxt
ReDim Preserve words(i)
words(i) = inpTxt'i = i + 1

 For Each word In words
 
      iFound =Instr(1, ucase(Msgobj.htmlbody),ucase(word(i)), 1)
  exit For

 Next
Loop
Close #FlNum

Hi matt ,
i defintely think the difference is vbscript versus vb.. Your code looks like its VB-ish.... VBscript doesnt like Dim X as Y , just Dim X.....

Cheers!

It could be a VB/VBS thing. I don't actually use VBS but it should work the same.

I've done a bit of researching on the error, here is the most common reason I've found (as I'm sure you have too):
-----
PRO-00054 Expected End-of-Statement at column number in line number of file string

Cause: The precompiler expected to find a statement terminator at the end of an EXEC statement but found something else. This can happen if tabs were embedded in the source code (because the precompiler has no way of knowing how many spaces a tab represents).

Action: If tabs are embedded in the source code, replace them with spaces. Check the statement syntax and check that each EXEC statement has a terminator. For embedded CREATE {FUNCTION | PROCEDURE | PACKAGE} statements and for embedded PL/SQL blocks, check that the statement terminator is END-EXEC.
-----

But upon further researching, it appears that using FSO (FileSystemObject) may work better for you.  Try the following:


Dim fso
Dim badWordFile
Dim inpTxt
Dim i
Dim fl
Dim words()
Dim word

badWordFile = "c:\evtsink\words.txt"

Set fso = CreateObject("Scripting.FileSystemObject")
i = 0
Set fl = fso.OpenTextFile(badWordFile, 1)
Do While fl.AtEndOfStream <> True
 inpTxt fl.ReadLine
 ReDim Preserve words(i)
 words(i) = inpTxt 'i = i + 1
 For Each word In words
 
     iFound = InStr(1, UCase(Msgobj.htmlbody), UCase(word(i)), 1)
  Exit For

 Next

Loop


See if that works for you! Works for me, but again I'm not using VBS (didn't even notice that in your question title until earlier today)
Matt

By the way, you're not annoying me :) You asked if I could help you with the code, I said of course, and you posted the code. Asking a followup like you did is just keeping me honest, not a problem at all! I have been known to forget a few things now and then :P

Cheers!

Will give it a go!

Hi Matt...

getting there :-)

I have the following....

*******************************

Dim fso
Dim badWordFile
Dim inpTxt
Dim i
Dim fl
Dim words()
Dim word

badWordFile = "c:\evtsink\words.txt"

Set fso = CreateObject("Scripting.FileSystemObject")
'i = 0
Set fl = fso.OpenTextFile(badWordFile,1)
Do While fl.AtEndOfStream <> True
 inpTxt=fl.ReadLine
 ReDim Preserve words(i)

 words(i) = inpTxt
'wscript.echo inptxt
 For Each word In words
'wscript.echo word(i)
     iFound = InStr(1,UCase(Msgobj.htmlbody), UCase(word(i)), 1)

  Exit For

 Next

Loop

**************************************

I can get a value for inptxt ( it reads from the txt file which is great) but wscript.echo word(i) Does not return anything......

I also had to put an equals in "inpTxt=fl.ReadLine"
Does this give you any clearer of an idea?

Thanks!

that does it :) thanks a million for your assistance!

Glad you got it straightened out, sorry it took so long!
Thanks for the grade!