'=========================================================================
'
' AUTHOR: 	Ben Christian (email@benchristian.com)
'
' DATE: 	24/03/06
'
' COMMENT: 	Search for text in message attachements
'
'=========================================================================

'Temp Folder
strDir = "C:\CheckMessage"
Const ForReading = 1

strCntNumber = InputBox("Attachment Search Tool" & VBCR & "Ben Christian 2006" & VBCR & VBCR & VBCR & "Enter the text to search message attachments for:","text string")

If strCntNumber = "" Then 
	msgbox "You must enter a text string to search on.  Run the script again and enter a text string when prompted"
	wscript.quit
End If

strCntNumber = Lcase(strCntNumber)

Set objFSO = CreateObject("Scripting.FileSystemObject")
If Not objFSO.FolderExists(strDir) Then
	objFSO.CreateFolder(strDir)
End If


Set objOutlookApp = CreateObject("Outlook.Application")
Set objSelection = objOutlookApp.ActiveExplorer.Selection

For Each Item In objSelection

	For Each Attachment in Item.Attachments
		strFile = strDir & "\" & Attachment.FileName
		Attachment.SaveAsFile(strFile)
		Set objTextFile = objFSO.OpenTextFile(strFile, ForReading, True)
		TextBody = obJTextFile.ReadAll
		TextBody = Lcase(TextBody)
		objTextFile.Close
		objFSO.DeleteFile(strFile)
		
		IF InStr(TextBody,strCntNumber) > 0 Then
			Item.Display
			wscript.quit
		End If
		
	Next

Next

msgbox strCntNumber & " was not Found in Message Attachments"