'Alan Kaplan
'alan dot kaplan at va dot gov
'10-16-2008
'v2.  Audits calendar attachments and size

dim wshShell
Set wshShell = WScript.CreateObject("WScript.Shell")


If (Not IsCScript()) Then 		'If not CScript, re-run with cscript...
	dim quote, strArgs, i
	quote=chr(34)
	
	For i  = WScript.Arguments.Count -1 to  0 Step -1
		strArgs = WScript.Arguments(i) & Space(1) &  strArgs
	Next
	
	WshShell.Run "CScript.exe " & quote & WScript.ScriptFullName & quote & space(1) & strArgs, 1, true
    WScript.Quit            	'...and stop running as WScript
End If

Dim fso,logfile, appendout
logfile = wshShell.ExpandEnvironmentStrings("%userprofile%") & "\desktop\Calendar Attachments.xls" 

'setup log
Const ForAppend = 8
Set fso = CreateObject("Scripting.FileSystemObject")

If fso.FileExists (logfile) Then 
	fso.DeleteFile logfile, True
End If 

Set appendout = fso.OpenTextFile(logfile, ForAppend, True)


'Based loosely on code written by Helen Feddema 8-3-98
Dim nms
Dim objFolder
Dim objItems
Dim objItem
   
Dim oOutlook 	'As New Outlook.Application
Set oOutlook = CreateObject("Outlook.Application")
'Set reference to default Calendar folder
Set nms = oOutlook.GetNamespace("MAPI")
Set fld = nms.GetDefaultFolder(9)
Set itms = fld.Items
lngCount = itms.Count
 
 
If lngCount = 0 Then
	MsgBox "No Calendar items found to export",vbOKOnly + vbCritical,"Error"
	WScript.Quit
Else
     MsgBox  "Total number of calendar items: " & itms.Count, vbokay,"Total Count"
End If

EchoAndLog "Date	Subject	Size KB"

'Iterate through items in Calendar folder, and export a few fields
'from each item to a row in the Calendar worksheet
For Each itm in itms
	If itm.attachments.count > 0 Then 
		If itm.Subject <> "" Then
			strSubject = itm.Subject
		Else
			strSubject = "[Empty Subject]"
		End If 

		If itm.Start <> "" Then 
			strStartTime = itm.Start
		Else
			strStartTime = "{Empty Start Time]"
		End If 
		
		EchoAndLog strStartTime & vbTab & strSubject & vbTab & itm.size
	    intSize = intSize + itm.size
	End If 
	
Next

Dim message 
message = "Script complete. Log Calendar Attachments.xls written to your desktop." & _
" Total size of calendar items with attachments is " & round(intSize /1024,2) & " MB. "
MsgBox message ,vbInformation+vbOKOnly,"Done"

Sub EchoAndLog (message)
'Echo output and write to log
	Wscript.Echo message
	AppendOut.WriteLine message
End Sub  


Function IsCScript()
    If (InStr(UCase(WScript.FullName), "CSCRIPT") <> 0) Then
        IsCScript = True
    Else
        IsCScript = False
    End If
End Function