EventsToOutlook.sql
CREATE PROCEDURE spEventsToOutlook (@uid int=27) AS
SELECT rtrim(a.event_tx) as Subject,
'Start Time' = a.START_TS,
'End Time' = a.END_TS,
'Event Date' = a.EVENT_DT,
'Location' = rtrim(a.location_tx),
'Notes' = a.notes_tx
FROM events a
WHERE a.user_id = @uid
ORDER BY event_dt,start_ts
SQLToOutlook.vbs
1 Dim Connection1
2 Dim strEmail
3 Dim SQLLogin
4 Dim RSLogin
5 Dim UserID
6 Dim SQL2
7 Dim RS1
8 Dim objOutlook
9 Dim mNameSpace
10 Dim strCalendarFolder
11 Dim strTaskFolder
12 Dim myAppointment
13 Dim myTask
14 Dim dtStart
15 Dim dtEnd
16
17 Const olFolderCalendar = 9
18 Const olFolderTasks = 13
19
20 Set RSLogin = Wscript.CreateObject("ADODB.Recordset")
21 Set objOutlook = CreateObject("Outlook.application")
22 Set mNameSpace = objOutlook.GetNameSpace("MAPI")
23 Set strCalendarFolder = mNameSpace.GetDefaultFolder(olFolderCalendar)
24 Set strTaskFolder = mNameSpace.GetDefaultFolder(olFolderTasks)
25
26 call subOpenConnection
27
28 strEmail = InputBox("Please enter your e-mail address","Login Information")
29 SQLLogin = "select * from users where email_tx = "& "'" & strEmail & "'"
30 RSLogin.open SQLLogin,Connection1, 3
31
32 if not RSLogin.eof then
33 UserID = RSLogin("User_ID")
34 else
35 UserID = 0
36 end if
37
38 set RSLogin = nothing
39
40 SQL2 = "spSessionsToOutlook " & UserID
41 Set RS1 = Connection1.Execute(SQL2)
42
43 do while not RS1.eof
44 dtEvent = cdate(RS1("Event Date"))
45 dtStart = right(cdate(RS1("Start Time")),11)
46 dtEnd = right(cdate(RS1("End Time")),11)
47 wscript.echo "dtStart " & dtStart & vbCRLF & "dtEnd " & dtEnd
48 if dtEvent = "1/1/1900" then
49 Set myTask = strTaskFolder.Items.Add
50 With MyTask
51 .Subject = "Booth #" & RS1("location") & " " & RS1("Subject")
52 .Body = RS1("notes")
53 .Save
54 End With
55 ' wscript.echo "Task Added"
56 else
57 if dtStart = "1/1/1900" or dtEnd = "1/1/1900" then
58 str = "Subject = " & RS1("Subject") & vbCRLF
59 str = str & "A Start or End Time for this appointment was not specified."
60 wscript.echo str
61 else
62 Set myAppointment = strCalendarFolder.Items.Add
63 With MyAppointment
64 .Subject = RS1("Subject")
65 .Start = dtEvent & " " & dtStart
66 .End = dtEvent & " " & dtEnd
67 .Location = RS1("location")
68 .Body = RS1("notes")
69 .Save
70 End With
71' wscript.echo "Appointment Added"
72 end if
73 end if
74 RS1.movenext
75 loop
76
77 Set myTask = Nothing
78 Set myAppointment = Nothing
79 Set mNameSpace = Nothing
80 Set objOutlook = Nothing
81
82 call subCloseConnection
83
84 Sub subOpenConnection()
85 Dim ConnectionString
86 Set Connection1 = WScript.CreateObject("ADODB.Connection")
87 ConnectionString = "Provider=SQLOLEDB; "
88 ConnectionString = ConnectionString & "SERVER=SERVER; "
89 ConnectionString = ConnectionString & "UID=username; "
90 ConnectionString = ConnectionString & "PWD=password; "
91 ConnectionString = ConnectionString & "database=eventsdb"
92 Connection1.Open ConnectionString
93 End Sub
94
95 Sub subCloseConnection()
96 Connection1.Close
97 End Sub
