'****************************************************************************
' Processing Starts Here
'****************************************************************************

'If WScript.Arguments.Count = 3 Then
'	Set CalendarName = WScript.Arguments.Item(0)
'Else
'	Wscript.Echo "Run from the web so that the calendar name is included in the path."
'	Wscript.Quit
'End If

Set ShellObj = WScript.CreateObject("Wscript.Shell")
Set NetObj = WScript.CreateObject("WScript.Network")
Set FSO = WScript.CreateObject("Scripting.FilesystemObject")
Set XMLHTTP = WScript.CreateObject("Microsoft.XMLHTTP")
CompName = UCASE(Trim(NetObj.ComputerName))

strDriveLetter = "C:" 
intCount = 0 
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")

On Error Resume Next 

respond = MsgBox("Do you wish to begin deleting the old ABAC Calendar events to import the current ABAC calendar events?", vbYesNoCancel)
If respond = 2 Then
	MsgBox "Exiting without importing the ABAC Calendars."
	WScript.Quit
End If

Const adOpenForwardOnly = 0
Const adOpenKeyset = 1
Const adOpenDynamic = 2
Const adOpenStatic = 3
Const adLockReadOnly = 1
Const adLockPessimistic = 2
Const adLockOptimistic = 3
Const adLockBatchOptimistic = 4

On Error Resume Next

DriveExists = False 
' Sets the loop to check for all alpha letters D-Z
For intCount = 65 To 90
	DriveAvailable = True 
	Set colItems = Nothing
	Set colItems = objWMIService.ExecQuery("Select * from Win32_LogicalDisk",,48)
	For Each objItem in colItems
		If objItem.Name = chr(intCount) & ":" Then
			DriveAvailable = False
		End If
	Next

	If DriveAvailable = True Then
		strDriveLetter = chr(intCount) & ":"
		intCount = 91
	End If
Next

If strDriveLetter <> "C:" Then
	NetObj.MapNetworkDrive strDriveLetter, strRemotePath 
Else MsgBox "No drive letters available to map for running the script. Exiting. Please disconnect a mapped drive and re-run this script."
	wscript.quit
End If

NetObj.RemoveNetworkDrive strDriveLetter, "True"
NetObj.MapNetworkDrive strDriveLetter, "\\10.19.1.15\facilitiescalendar","False"
NetObj.MapNetworkDrive strDriveLetter, "\\10.19.1.15\facilitiescalendar","False", "abac_web\outlook","Aej7370its"

set conn= WScript.CreateObject("ADODB.Connection")
conn.Provider="Microsoft.Jet.OLEDB.4.0"
conn.Open strDriveLetter & "/Scheduling.mdb"
set rst= WScript.CreateObject("ADODB.recordset")

Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNameSpace("MAPI")
Set objCalendarFolder = myNameSpace.GetDefaultFolder(9)
Set objCalendar = objCalendarFolder.Items
NumItems = objCalendar.Count

DelCount = 0
FoundCount = 0
Set MyCalendar = objCalendarFolder.Items
Set CalendarEvent = MyCalendar.GetFirst
NumItemsFound = MyCalendar.Count


If respond = 1 Then

MsgBox NumItemsFound & " NumItemsFound"

If NumItemsFound > 0 Then
	MsgBox "You have a total of " & NumItems & " Outlook calendar events which will be searched to find in your ABAC Calendar events to delete."


For Each CalendarEvent In MyCalendar
	If CalendarEvent.Categories = "ABAC TFEE" Then
'		MsgBox CalendarEvent.Categories & ": " & CalendarEvent.Subject
		FoundCount = FoundCount + 1
	End If

Next

If FoundCount > 0 Then
	MsgBox FoundCount & " ABAC Events will be deleted from your Outlook Calendar."

DelCount = 0
Do While DelCount < FoundCount 
	Set CalendarEvent = MyCalendar.GetFirst
	For Each CalendarEvent In MyCalendar 
		If CalendarEvent.Categories = "ABAC TFEE" Then
			MsgBox "Deleting " & CalendarEvent.Subject & ": " & CalendarEvent.Location & ": " & CalendarEvent.Start & ": " & CalendarEvent.End
			CalendarEvent.Delete
			DelCount = DelCount + 1
		End If
	Next
Loop

If DelCount > 0 Then
	MsgBox DelCount & " deleted out of " & NumItemsFound & " Calendar Events."
End If

End If

End If

On Error Resume Next

End If

'MsgBox "Importing the current/new ABAC Calendar Events..."

AddCount = 0
ShowAll = " Select * From Calendar where "

CalendarCount = 0

ABACABAC = MsgBox("Do you wish to import the ABAC Master calendar?", vbYesNo)
If ABACABAC <> 7 Then
	ShowAll = ShowAll & " (BldgCode = 'ABAC' and RoomCode = 'ABAC')"
	CalendarCount = CalendarCount + 1
End If

ABACPYRL = MsgBox("Do you wish to import the ABAC Payroll calendar?", vbYesNo)
If ABACPYRL <> 7 Then
	If CalendarCount > 0 Then
		ShowAll = ShowAll & " or "
	End If
	ShowAll = ShowAll & " (BldgCode = 'ABAC' and RoomCode = 'PYRL')"
	CalendarCount = CalendarCount + 1
End If

ABACREGI = MsgBox("Do you wish to import the ABAC Registrar calendar?", vbYesNo)
If ABACREGI <> 7 Then
	If CalendarCount > 0 Then
		ShowAll = ShowAll & " or "
	End If
	ShowAll = ShowAll & " (BldgCode = 'ABAC' and RoomCode = 'REGI')"
	CalendarCount = CalendarCount + 1
End If

ABACORIE = MsgBox("Do you wish to import the ABAC Orientation calendar?", vbYesNo)
If ABACORIE <> 7 Then
	If CalendarCount > 0 Then
		ShowAll = ShowAll & " or "
	End If
	ShowAll = ShowAll & " (BldgCode = 'ABAC' and RoomCode = 'ORIE')"
	CalendarCount = CalendarCount + 1
End If

ABACAPPL = MsgBox("Do you wish to import the ABAC Application calendar?", vbYesNo)
If ABACAPPL <> 7 Then
	If CalendarCount > 0 Then
		ShowAll = ShowAll & " or "
	End If
	ShowAll = ShowAll & " (BldgCode = 'ABAC' and RoomCode = 'APPL')"
	CalendarCount = CalendarCount + 1
End If

ABACTFEE = MsgBox("Do you wish to import the ABAC Tuition and Fees calendar?", vbYesNo)
If ABACTFEE <> 7 Then
	If CalendarCount > 0 Then
		ShowAll = ShowAll & " or "
	End If
	ShowAll = ShowAll & " (BldgCode = 'ABAC' and RoomCode = 'TFEE')"
	CalendarCount = CalendarCount + 1
End If

ABACAAES = MsgBox("Do you wish to import the ABAC Campus and Community Arts calendar?", vbYesNo)
If ABACAAES <> 7 Then
	If CalendarCount > 0 Then
		ShowAll = ShowAll & " or "
	End If
	ShowAll = ShowAll & " (BldgCode = 'ABAC' and RoomCode = 'AAES')"
	CalendarCount = CalendarCount + 1
End If

ABACSTDN = MsgBox("Do you wish to import the ABAC Student Events calendar?", vbYesNo)
If ABACSTDN <> 7 Then
	If CalendarCount > 0 Then
		ShowAll = ShowAll & " or "
	End If
	ShowAll = ShowAll & " (BldgCode = 'ABAC' and RoomCode = 'STDN')"
	CalendarCount = CalendarCount + 1
End If

ABACATHL = MsgBox("Do you wish to import the ABAC Athletics calendar?", vbYesNo)
If ABACATHL <> 7 Then
	If CalendarCount > 0 Then
		ShowAll = ShowAll & " or "
	End If
	ShowAll = ShowAll & " (BldgCode = 'ABAC' and RoomCode = 'ATHL')"
	CalendarCount = CalendarCount + 1
End If

ABACTRNG = MsgBox("Do you wish to import the ABAC Faculty and Staff Training calendar?", vbYesNo)
If ABACTRNG <> 7 Then
	If CalendarCount > 0 Then
		ShowAll = ShowAll & " or "
	End If
	ShowAll = ShowAll & " (BldgCode = 'ABAC' and RoomCode = 'TRNG')"
	CalendarCount = CalendarCount + 1
End If

ShowAll = ShowAll & " Order by BldgCode, RoomCode"

'MsgBox ShowAll

If CalendarCount > 0 Then

Dim objOL 'As Outlook.Application
Dim objEvent 'As Outlook.AppointmentItem
Const olAppointmentItem = 1
Const olMeeting = 1
Const olFree = 0

Set objOL = CreateObject("Outlook.Application")
Set objEvent = objOL.CreateItem(olAppointmentItem)

rst.Open ShowAll, conn
rst.MoveFirst
AddCount = 0

Do While Not rst.EOF
	AddCount = AddCount + 1
	Set objEvent = objOL.CreateItem(olAppointmentItem)
'	MsgBox AddCount & "A: " & rst.fields.item("Event")  & " " &  rst.fields.item("BldgCode") & " " & rst.fields.item("RoomCode") & " " & rst.fields.item("Event_DT") & " " & rst.fields.item("BeginTime")
	Set objEvent = objEvents.CreateItem(1)

	objEvent.Subject = rst.fields.item("Event")

	If rst.fields.item("RoomCode") = "PSBO" Then
		objEvent.Location = "ABAC Public Service & Business Outreach Calendar: See Notes for Details"
	End If

	If rst.fields.item("RoomCode") = "TRNG" Then
		objEvent.Location = "ABAC Faculty & Staff Training Calendar: See Notes for Details"
	End If

	If rst.fields.item("RoomCode") = "AAES" Then
		objEvent.Location = "ABAC Campus and Community Arts Calendar: See Notes for Details"
	End If

	If rst.fields.item("RoomCode") = "ATHL" Then
		objEvent.Location = "ABAC Athletics Calendar: See Notes for Details"
	End If

	If rst.fields.item("RoomCode") = "REGI" Then
		objEvent.Location = "ABAC Registrar Calendar: See Notes for Details"
	End If

	If rst.fields.item("RoomCode") = "ABAC" Then
		objEvent.Location = "ABAC Master Calendar: See Notes for Details"
	End If

	If rst.fields.item("BeginTime") = rst.fields.item("EndTime") Then
		objEvent.Duration = 0
		objEvent.AllDayEvent = True
	Else
		objEvent.AllDayEvent = False
		objEvent.Duration = DateDiff("n",FormatDateTime(DateValue(rst.fields.item("Event_DT")),vbShortDate) & " " & FormatDateTime(TimeValue(rst.fields.item("BeginTime")), vbShortTime),FormatDateTime(DateValue(rst.fields.item("Event_DT")),vbShortDate) & " " & FormatDateTime(TimeValue(rst.fields.item("EndTime")), vbShortTime))
'		objEvent.End = FormatDateTime(DateValue(rst.fields.item("Event_DT")),vbShortDate) & " " & FormatDateTime(TimeValue(rst.fields.item("EndTime")), vbShortTime)
	End If

	objEvent.Start = FormatDateTime(DateValue(rst.fields.item("Event_DT")),vbShortDate) & " " & FormatDateTime(TimeValue(rst.fields.item("BeginTime")), vbShortTime)

	If rst.fields.item("FirstName") <> "" Then
		objEvent.Body = "Requested by: " & rst.fields.item("FirstName") &  " "  & rst.fields.item("LastName") &  " "  & rst.fields.item("email") & chr(12) & chr(15) & Replace(rst.fields.item("Comments"),"<br>", chr(12) & chr(15),1,-1,1)
	Else objEvent.Body = Replace(rst.fields.item("Comments"),"<br>", chr(12) & chr(15),1,-1,1)
'		Replace(string,find,replacewith[,start[,count[,compare]]])
'		count Optional. Specifies the number of substitutions to perform. Default value is -1, which means make all possible substitutions 
	End If

	objEvent.BusyStatus = 0
	objEvent.ReminderMinutesBeforeStart = 0
	objEvent.ReminderSet = False
	objEvent.ReminderTime = FormatDateTime(TimeValue(rst.fields.item("6:00 AM")), vbShortTime)
	objEvent.Categories = "ABAC " & rst.fields.item("RoomCode")

	objEvent.Save
	Set objAppt = Nothing

	rst.MoveNext
Loop

EndDateTime = Now()

Msgbox "ABAC Events: " & AddCount & " added."

Else MsgBox "No ABAC Calendars selected for importing!"

End If

MsgBox "ABAC Calendar: Completed. Exiting! Bye!"

NetObj.RemoveNetworkDrive strDriveLetter, "True"

' Clean up
rst.Close
conn.Close
Set objEvent = Nothing
Set objEvents = Nothing
Set objEventsFolder = Nothing
Set myOlApp = Nothing
Set myNameSpace = Nothing
set rst = nothing
set conn = nothing
Set objCalendar = Nothing
Set objCalendarFolder = Nothing
Set myNameSpace = Nothing
Set myOlApp = Nothing

session.Abandon

WScript.Quit