Cant Reply to Meeting Request/Appointment created Progrmatically

S

Scott Townsend

When we create a Meeting Request or an appointment programmatically and then
open it in outlook client, add an attendee, that attendee cannot accept, or
decline, etc the Meeting request. They have the Buttons to reply, but when
they click on them they do not get the Dialog that allows them to send,
edit, don't send the response.

This happens on multiple Outlook 2003, Outlook 2002 and Mobile Outlook
Clients. So its not the Client. Something in the Appointment is not getting
set right when we create the appointment.

Any Suggestions?

Thanks,
Scott<-=
 
K

Ken Slovak - [MVP - Outlook]

It might help if we knew how you're creating things. Show some of your code.
 
S

Scott Townsend

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
 
S

Scott Townsend

No Reply? )-;

Scott Townsend said:
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
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Changing appointment to AllDayEvent,. Recipients get meeting request for specific tim 1
How to send calendar appointment or meeting request using .Net cla 1
issue with the sender's name getting changed 1
Alternative To New Item Alert Window 0
How to include mulitple meeting attendee via VBA? 1
Access 2003 appointment to Outook 2003 1
Meeting request changes to Appointment 1
Macro to Always Invite Same Person to an Appointment or Meeting Re 1

Top