The code is running within a SQL DTS Job, so its just VBScript.
I've also downloaded OutLookSpy and have a great PDF File that has all of
the Differences between a Meeting Created in Outlook and hte Meeting we
created. There are Several Differences, though I dont know what many of
hte property IDs are so its hard to tell if they are important.
The PDF File can be found here:
www<.dot.>eandm<.dot.>com/scott/meeting-requests.pdf
Here is the DTS Job Code:
Thanks!
Scott<-
OPTION EXPLICIT
'**********************************************************************
' Visual Basic Transformation Script
' For a description of codes to access appointment fields. Check out
http://www.cdolive.com/cdo10.htm
'************************************************************************
Const cStrServer = "<SMTP Server IP>"
Const cStrMailbox ="<Exchange ADMIN User>"
Const bdebug = 1
Const CdoPropSetID1 = "0220060000000000C000000000000046"
Const CdoPropSetID2 = "0320060000000000C000000000000046"
Const CdoPropSetID3 = "0420060000000000C000000000000046"
Const CdoPropSetID4 = "0820060000000000C000000000000046"
Const CdoPropSetID5 = "2903020000000000C000000000000046"
Const CdoPropSetID6 = "0E20060000000000C000000000000046"
Const CdoPropSetID7 = "0A20060000000000C000000000000046"
DIM fso, fname
DIM StrMailBox
DIM StrLastMailbox
DIM bstrProfileInfo
Dim objSession, objInfoStores, objInfoStore, objTopFolder, objFolders,
objFolder
Dim objMessages, objOneMessage, objAppt, objSender,
objRecipient1,objRecipient2, objRecipient3, objRecipient4, objRecipient5,
objRecipient0
Dim strStoreID, isMeeting
Function Start()
StrLastMailbox = ""
IF bdebug = 1 THEN
Set fso = CreateObject("Scripting.FileSystemObject")
Set fname = fso.CreateTextFile("c:\debugdts1.txt")
End if
Start = DTSTransformStat_OK
End Function
Function Endit()
If bdebug = 1Then
fname.Close
Set fname = Nothing
Set fso = Nothing
End If
Endit = DTSTransformStat_OK
End Function
Function Logoff()
Set objSession = Nothing
Set objInfoStores = Nothing
Set objInfoStore = Nothing
Set objTopFolder = Nothing
Set objFolder = Nothing
Set objFolders = Nothing
Set ObjMessages = Nothing
End Function
Function Logon()
Dim i
Logoff()
bstrProfileInfo = cStrServer & vbLf & StrMailbox
If bdebug = 1 then
fname.WriteLine("Logging on to email with profile : " + bstrProfileInfo)
End If
Set objSession = CreateObject("mapi.session")
objSession.Logon "", "", False, True, 0, True, bstrProfileInfo
if bdebug = 1 THEN
fname.WriteLine("Mapi Session:"+ objSession.Version)
End if
Set objInfoStores = objSession.InfoStores
For i = 1 To objInfoStores.Count
If Left(objInfoStores.Item(i),10) = "Mailbox - " Then
Set objInfoStore=objInfoStores.Item(i)
Exit For
End If
Next
IF ISEMPTY(objInfoStore) THEN
Logon = DTSTransformStat_SkipRow
Exit Function
END IF
Set objTopFolder = objInfoStore.RootFolder
Set objFolders = objTopFolder.Folders
Set objFolder=objFolders.GetFirst()
Do Until objFolder.Name = "Calendar"
Set objFolder=objFolders.GetNext()
IF ISEMPTY(objFolder) or ISNULL(objFolder) THEN
Exit Do
END IF
Loop
IF ISEMPTY(objFolder) or ISNULL(objFolder) THEN
Logon = DTSTransformStat_SkipRow
Exit Function
END IF
strStoreID = objFolder.storeID
Set objMessages = objFolder.Messages
If bdebug = 1 Then
fname.WriteLine("All Logged On to Email")
End if
Logon = DTSTransformStat_OK
End Function
Function Main()
Dim strMessageID, strLastMailBox, strStoreID, strBodyText, strLocation,
StrFromAddress
Dim dt_startdate, dt_enddate, dt_now
Dim i, ihours, iminutes
Dim return
StrMailBox = DTSSource("user_name")
StrFromAddress = DTSSource("email_address")
IF StrMailBox <> StrLastMailBox THEN
return = Logon()
Main = return
IF return <> DTSTransformStat_OK Then
Exit Function
End if
StrLastMailBox = StrMailBox
END IF
dt_now = Date()
IF DTSSource("source_status") = "New" OR DTSSource("source_status") =
"Modified" THEN
strBodyText = "A Meeting has been scheduled with " +
DTSSource("contact_name") + " from " + DTSSource("customer_name") + vbCRLF
+ VBCRLF
strBodyText = strBodyText + "Find it at : ="+ CSTR(DTSSource("task_id"))
+ " " + vbCRLF + vbCRLF
strBodyText = strBodyText + DTSSource("description") + vbCRLF + vbCRLF
IF DTSSource("source_status") = "New" THEN
Set objAppt = objMessages.Add
StrBodyText = strBodyText + " (Added on "+ CSTR(Date()) + " " +
CSTR(Time()) +")"
objAppt.Fields.Add &H30070040, dt_now ' Set Creation Time
objAppt.ConversationTopic = "Meeting with " + DTSSource("contact_name")
+ " ("+DTSSource("customer_name")+")"
objAppt.ConversationIndex = objSession.CreateConversationIndex()
ELSE
ON ERROR RESUME NEXT ' Disable Error Catching Due to Posible lookup to
find a message that doesn't exist
StrMessageID = DTSSource("outlook_ID")
Set objAppt = objSession.GetMessage(strMessageID, strStoreID)
' IF Err.Number = &H8004010F or Err.Number = &H80040107 THEN
IF Err.Number <> 0 THEN
Set objAppt = objMessages.Add
StrBodyText = strBodyText + " (ReAdded on "+CSTR( Date()) + " " +
CSTR(Time()) +")"
objAppt.Fields.Add &H30070040, dt_now ' Set Creation Time
objAppt.ConversationTopic = "Meeting with " + DTSSource("contact_name")
+ " ("+DTSSource("customer_name")+")"
objAppt.ConversationIndex = objSession.CreateConversationIndex()
ELSE
StrBodyText = strBodyText + " (Modified on "+ CSTR(Date()) + " " +
CSTR(Time()) +")"
END IF
ON ERROR GOTO 0 ' Enable Error Catching
END IF
objAppt.Type = "IPM.Appointment"
objAppt.Subject = "Meeting with " + DTSSource("contact_name") + "
("+DTSSource("customer_name")+")"
objAppt.Fields.Add &H1000001F, StrBodyText
objAppt.Fields.Add &H30080040, dt_now ' Set Modification Time
' Set Recipient Information
IsMeeting = 0
SET objRecipient0 = objAppt.Recipients.Add ("", "SMTP:"&strFromAddress,
1 )
objRecipient0.Resolve
IF Len(DTSSource("invitee1_email")) >0 THEN
isMeeting = 1
SET objRecipient1 = objAppt.Recipients.Add ("",
"SMTP:"&DTSSource("invitee1_email"), 1 )
objRecipient1.Resolve
END IF
IF Len(DTSSource("invitee2_email"))>0 THEN
isMeeting = 1
SET objRecipient2 = objAppt.Recipients.Add ("",
"SMTP:"&DTSSource("invitee2_email"), 1)
objRecipient2.Resolve
END IF
IF Len(DTSSource("invitee3_email"))>0 THEN
isMeeting = 1
SET objRecipient3 = objAppt.Recipients.Add ("",
"SMTP:"&DTSSource("invitee3_email"), 1)
objRecipient3.Resolve
END IF
IF Len(DTSSource("invitee4_email"))>0 THEN
isMeeting = 1
SET objRecipient4 = objAppt.Recipients.Add ("",
"SMTP:"&DTSSource("invitee4_email"), 1)
objRecipient4.Resolve
END IF
IF Len(DTSSource("invitee5_email"))>0 THEN
isMeeting = 1
SET objRecipient5 = objAppt.Recipients.Add ("",
"SMTP:"&DTSSource("invitee5_email"), 1)
objRecipient5.Resolve
END IF
If isMeeting = 1 THEN
objAppt.Fields.Add "0x8219",vbLong,1, CdoPropSetID1 ' Set the IS
Meeting Tag
END IF
' Set Start Time and End time of Appointment
dt_startdate =CDATE(DTSSource("thedate"))
ihours = CDBL(DTSSource("duration"))
iminutes = ihours * 60
dt_enddate = DateAdd("N", iminutes , dt_startdate)
objAppt.Fields.Add "0x820D", vbDate, dt_startdate, CdoPropSetID1 ' Set
Start Date
objAppt.Fields.Add "0x820E", vbDate, dt_enddate, CdoPropSetID1 ' Set
End Date
objAppt.Fields.Add "0x8205", vbLong, 2, CdoPropSetID1 ' Set Busy
Status to "Busy"
objAppt.Fields.Add "0x8503", vbBoolean, vbFalse, CdoPropSetID4 ' Set
Reminder to "No"
objAppt.Fields.Add "0x8223", vbBoolean, vbFalse, CdoPropSetID1 ' Set
Recurring to No
' Set Location Field to whatever description the user put in.
strLocation = DTSSource("location")
objAppt.Fields.Add "0x8208", vbString, strLocation , CdoPropSetID1 ' Set
Location
objAppt.Update true, true
DTSDestination("event_id") = DTSSource("event_id")
strMessageID = objAppt.ID
DTSDestination("outlook_ID") = strMessageID
DTSDestination("source_timestamp") =DTSSource("last_modified_date")
IF isMeeting = 1 THEN
' objAppt.Send
END IF
Main = DTSTransformstat_UpdateQuery
ELSEIF DTSSource("source_status") = "Deleted" THEN
DTSDestination("event_id") = DTSSource("event_id")
StrMessageID = DTSSource("outlook_ID")
ON ERROR RESUME NEXT
Set objAppt = objSession.GetMessage(strMessageID, strStoreID)
' IF objAppt.MeetingStatus = 1 THEN ' If This is a Meeting
' objAppt.Fields.Add "0x8219",vbLong,2, CdoPropSetID1 ' Set the IS
Meeting Tag
' objAppt.Send ' Tell Invitees
' END IF
objAppt.Delete
ON ERROR GOTO 0
Main = DTSTransformStat_DeleteQuery
ELSE
Main = DTSTransformStat_SkipRow
END IF
Set objAppt = Nothing
Set objMessages = Nothing
Set ObjFolder = Nothing
Set objFolders = Nothing
Set objSession = Nothing
End Function