Submitted By: Anonymous Submission
Language: VBScript
Description: Counts event types 9 and 26 for a certain user in an Exchange Server 5.5 log file.
Script Code
Const ForReading = 1
Const ForWriting = 2
strTo = InputBox("Enter the directory name for the user that you want a count for. The directory name is NOT the same as the email address and it is case sensitive. It's displayed on the advanced properties screen on the Exchange server.")
strEventType = InputBox("Enter the Exchange log event type to search for (see k.b. article 173364): ")
if strEventType <> 9 and strEventType <> 26 then
msgbox("The script isn't set up for event type " & strEventType & ". Sorry!")
wscript.quit
end if
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.getfolder(".")
if objFSO.folderexists(".\results") = False then objFSO.createfolder(".\results")
For Each objFile in objFolder.Files
If right(objFile.Name,4) = ".log" then
Set objCurrentFile = objFSO.OpenTextFile (".\" & objFile.Name, ForReading)
Set objOutFile = objFSO.createtextfile(".\results\" & strTo & "_" & strEventType & "_" & objFile.Name,True)
objOutFile.writeline "Count of event type " & strEventType & " for " & strTo & " from file " & objFile.Name
objOutFile.writeline "Times are given in Greenwich Mean Time" & vbCrLf & vbCrLf
intInternal = 0
intExternal = 0
intError = 0
Do Until objCurrentFile.AtEndOfStream
strLine = objCurrentFile.Readline
'split the line at all tabs and save the results in an array
strArrayLine = split(strLine,vbTab, -1, 1)
if ubound(strArrayLine) > 0 then
if strArrayLine(1) = "9" and strEventType = "9" then
'I've found an event type of 9. There will be one or more lines following this
'that list the recipients for this email. I'll need to look at each of those
'to see if any match my recipient. When I read a blank line
'I'll know I'm finished with this email
strLine = objCurrentFile.Readline
blnFoundAMatch = vbFalse
Do Until len(strLine) = 0
if instr(strLine, strTo) > 0 then blnFoundAMatch = vbTrue
strLine = objCurrentFile.ReadLine
Loop
if blnFoundAMatch then
'get the date strings all set to the same length so they don't
'throw off the formatting in the output report
if len(strArrayLine(2)) < 19 then
strArrayLine(2) = strArrayLine(2) & string((19 - len(strArrayLine(2))) ," ")
end if
'look for the strings that will indicate whether the email was sent internally
'or externally
if instr(strArrayLine(6),"/cn=RECIPIENTS/cn=") then
intInternal = intInternal + 1
objOutFile.writeline "Internal:" & vbTab & strArrayLine(2) & vbTab & strArrayLine(6)
elseif instr(strArrayLine(6), "(a)" ) then
intExternal = intExternal + 1
objOutFile.writeline "External:" & vbTab & strArrayLine(2) & vbTab & strArrayLine(6)
else
intError = intError + 1
objOutFile.writeline "Error:" & vbTab & strArrayLine(2) & vbTab & strArrayLine(6)
end if
end if 'end of foundamatch=true
end if 'end of event type 9
if strArrayLine(1) = "26" and strEventType = "26" then
'Field will be the distribution list recipient and field will be the sender
if instr(strArrayLine(5), strTo) > 0 then
if len(strArrayLine(2)) < 19 then
strArrayLine(2) = strArrayLine(2) & string((19 - len(strArrayLine(2))) ," ")
end if
if instr(strArrayLine(6),"/cn=RECIPIENTS/cn=") then
intInternal = intInternal + 1
objOutFile.writeline "Internal:" & vbTab & strArrayLine(2) & vbTab & strArrayLine(6)
elseif instr(strArrayLine(6), "(a)" ) then
intExternal = intExternal + 1
objOutFile.writeline "External:" & vbTab & strArrayLine(2) & vbTab & strArrayLine(6)
else
intError = intError + 1
objOutFile.writeline "Error:" & vbTab & strArrayLine(2) & vbTab & strArrayLine(6)
end if
end if 'end if strTo in strLine
end if 'enf of event type 26
end if 'end of if ubound > 0
Loop
objCurrentFile.Close
objOutFile.writeline "___________________________________________________________________________" & vbCrLf
objOutFile.writeline "Internal Total: " & intInternal & vbCrLf
objOutFile.writeline "External Total: " & intExternal & vbCrLf
if intError <> 0 then objOutFile.writeline "Error Total: " & intError & vbCrLf
objOutFile.Close
end if
Next
msgbox("done")
Note: Not all scripts run on all versions of Windows.
For online peer support, join The Official Scripting Guys Forum! To provide feedback or report bugs in sample scripts or on the Script Center, please contact scripter@microsoft.com.
Disclaimer
This script is not supported under any Microsoft standard support program or service. The script is provided AS IS without warranty of any kind. Microsoft further disclaims all implied warranties including, without limitation, any implied warranties of merchantability or of fitness for a particular purpose. The entire risk arising out of the use or performance of the script and documentation remains with you. In no event shall Microsoft, its authors, or anyone else involved in the creation, production, or delivery of the script be liable for any damages whatsoever (including, without limitation, damages for loss of business profits, business interruption, loss of business information, or other pecuniary loss) arising out of the use of or inability to use the script or documentation, even if Microsoft has been advised of the possibility of such damages.