We have a custom form we use for leave requests. The form has pretty basic
fields -- it allows the user to select the days and specific times and then
allows them to type a message. The "To" field is automatically populated
with their supervisor (which is pulled from Active Directory).

We're in the process of moving users from an older Windows 2003 Term Server
onto a new Windows 2003 Term Server. Both term servers have Office 2003 with
SP2 installed. On the new server the custom form opens fine, but it won't
populate the supervisor field. It works fine on the old term server and on
all of the desktops that are running Outlook.

Any ideas on why that one server won't work?

The form is published on the Exchange Server and we access it by going to
Tools/Choose Form and selecting it from the Organizational Forms Library.

Here's the code...it was written by a former employee:

-----------------------

Option Explicit

Const olFolderCalendar = 9
Const olOutOfOffice = 3
Const olFree = 0
Const olAppointmentItem = 1
Const olByValue = 1
Const olBCC = 3
Const olCC = 2

'Public Vacation Folder Path
Dim boolIsNew

Function Item_Open()
Dim strManager
Dim objPage
Dim objCtrl
Dim objRecip

'Stop
'Check to see if this is a new item
If Item.Size = 0 Then
boolIsNew = True

' try to get the name of my manager
strManager = GetMyManagerName()
If strManager vbNullString Then
Set objRecip = Item.Recipients.Add(strManager)
objRecip.Resolve
If objRecip.Resolved Then
Set objPage =
Item.GetInspector.ModifiedFormPages("Message")
Set objCtrl = objPage.Controls("cbToType")
objCtrl.SetFocus
End IF
End If
Else
boolIsNew = False
End If

'Stop
'Check the Approved Action
If Item.UserProperties.Find("Approved") "No Action" Then
Item.Actions.Item(5).Enabled = False
Item.Actions.Item(6).Enabled = False
End If
'MsgBox boolIsNew
End Function

Function Item_CustomAction(ByVal Action, ByVal NewItem)
Dim vacStart
Dim vacEnd
Dim toType
Dim vacHours
Dim vacComments
Dim strVacFolder
Dim hrAddress
Dim objNS
Dim vacApproverName
Dim vacApprovedName
Set objNS = Application.GetNamespace("MAPI")
'Stop
vacApproverName = objNS.CurrentUser.Name
vacApprovedName = Item.SenderName

hrAddress = "Corporate Payroll" '"Nancy Tarter" "Shane Kempton" '
strVacFolder = "Public Folders\All Public Folders\vacations"

vacStart = Item.UserProperties.Find("Vacation Start")
vacEnd = Item.UserProperties.Find("Vacation End")

toType = Item.UserProperties.Find("ToType")
vacHours = Item.UserProperties.Find("Time Off Hours")
vacComments = Item.ItemProperties.Item("Body")

Select Case Action.Name
Case "Approve"
'Make an Appointment
'Stop
Call AddAppointment(strVacFolder, vacStart, vacEnd,
toType, NewItem)

NewItem.Body = "Your time off request has been " & _
"approved: " & vbCrLf & _
"Approved For: " & vacApprovedName & vbCrLf & _
"Approved By: " & vacApproverName & vbCrLf & vbCrLf
& _
"Reason: " & toType & vbCrLf & _
"Dates: " & vacStart & " - " & vacEnd & vbCrLf & _
"Hours: " & vacHours & vbCrLf & _
"Comments: " & vacComments & vbCrLf & vbCrLf & _
"Drag the attached " & _
"Appointment to your Calendar. " & _
"Or, open it, then use File | Copy to Folder." &
vbCrLf & vbCrLf

'Send a Message to HR
Dim hr
Set hr = NewItem.Recipients.Add(hrAddress)
hr.Resolve
If hr.Resolved Then
hr.Type = olCC
End If

'Set the Approved Action
Item.UserProperties.Find("Approved") = "Approved"
Item.Save
Case "Disapprove"
'Disapprove Actions
Item.UserProperties.Find("Approved") = "Rejected"
Item.Save
Case Else
'Do Nothing
End Select
'Close the Form
Dim objInsp
Set objInsp = Item.GetInspector
objInsp.Close 2
End Function

Public Sub AddAppointment(ByVal strFolderPath,ByVal dStart,ByVal dEnd,ByVal
strSubject,ByVal NewItem)
Dim objAppt
Dim objVacFolder
Dim objAttachment

'Stop

Set objAppt = Application.CreateItem(olAppointmentItem)
With objAppt
.Start = dStart
.End = dEnd
.ReminderSet = False
.Subject = strSubject
.BusyStatus = olOutOfOffice
.Categories = Item.SenderName
.Body = "Hours: " & Item.UserProperties.Find("Time Off Hours") &
vbCrLf & _
"Comments: " & Item.ItemProperties.Item("Body")
End With

'Add the vacation as an Attachement
objAppt.Save
Set objAttachment = NewItem.Attachments.Add( _
objAppt, olByValue, , _
"Your Time Off")

'Stop

'Change a few properties on the appointment for the other calendars
objAppt.BusyStatus = olFree
objAppt.Subject = Item.SenderName & " - " & strSubject

'Add the vacation to the Approver's Calendar
Dim objMngrFolder
Dim objNS
Dim objItemCopy
Set objNS = Application.GetNamespace("MAPI")

Set objMngrFolder = objNS.GetDefaultFolder(olFolderCalendar)
Set objItemCopy = objAppt.Copy
If Not objMngrFolder Is Nothing Then
'objItemCopy.Move objMngrFolder
objItemCopy.Save
End If

'Stop

'Add the Appoinment to the Public Vacation Folder
'Set objVacFolder = GetFolder(strFolderPath)
Set objVacFolder = objNS.Folders.Item("Public
Folders").Folders.Item("All Public Folders").Folders.Item("vacations")

If Not objVacFolder Is Nothing Then
objAppt.Move objVacFolder
Else
objAppt.Delete
End If

Set objNS = Nothing
Set objItemCopy= Nothing
Set objMngrFolder = Nothing
Set objAppt = Nothing
Set objVacFolder = Nothing
Set objAttachment = Nothing
End Sub

Function GetMyManagerName()
Dim objNS
Dim objMe
Dim strName

Set objNS = Application.GetNamespace("MAPI")

Set objMe = objNS.CurrentUser
On Error Resume Next
strName = objMe.AddressEntry.Manager.Name
If Err = 0 Then
GetMyManagerName = strName
Else
GetMyManagerName = ""
End IF

Set objNS = Nothing
Set objMe = Nothing
End Function

Public Function GetFolder(strFolderPath)
Dim objNS
Dim colFolders
Dim objFolder
Dim arrFolders
Dim i

On Error Resume Next
strFolderPath = Replace(strFolderPath, "/", "\")
arrFolders = Split(strFolderPath, "\")
Set objNS = Application.GetNameSpace("MAPI")
Set objFolder = objNS.Folder.Item(arrFolders(0))

If Not objFolder Is Nothing Then
For i = 1 To UBound(arrFolders)
Set colFolders = objFolder.Folders
Set objFolder = Nothing
Set objFolder = colFolders.Item(arrFolders(i))
If objFolder Is Nothing Then
Exit For
End If
Next
End If

Set GetFolder = objFolder
Set colFolders = Nothing
Set objNS = Nothing
Set objFolder = Nothing
End Function

Function GetFolderPath(objFolder)
Dim strPath
Dim objParent
On Error Resume Next
strPath = "\" & objFolder.Name
Do While Err = 0
Set objParent = objFolder.Parent
If Err = 0 Then
strPath = "\" & objParent.Name & strPath
Set objFolder = objParent
Else
Exit Do
End If
Loop
GetFolderPath = "\" & strPath
Set objParent = Nothing
End Function

Function GetCalFolderPath()
Dim objFolder
Dim objNS
Set objNS = Application.GetNamespace("MAPI")
Set objFolder = objNS.GetDefaultFolder(olFolderCalendar)
GetCalFolderPath = GetFolderPath(objFolder)
Set objFolder = Nothing
Set objNS = Nothing
End Function

Did you try what I suggested earlier in your other thread -- do some diagnostics to determine more exactly what isn't working? So far all we know are symptoms? By watching the code execute, you should be able to pinpoint exactly where it is not doing what you expect. We don't even know if any of the code is running at all.

BTW, was the necessary scripting component installed on the new server? See http://support.microsoft.com/kb/302003/

--
Sue Mosher, Outlook MVP
Author of Microsoft Outlook 2007 Programming:
Jumpstart for Power Users and Administrators
http://www.outlookcode.com/article.aspx?id=54


"Eric32" wrote in message ...
We have a custom form we use for leave requests. The form has pretty basic
fields -- it allows the user to select the days and specific times and then
allows them to type a message. The "To" field is automatically populated
with their supervisor (which is pulled from Active Directory).

We're in the process of moving users from an older Windows 2003 Term Server
onto a new Windows 2003 Term Server. Both term servers have Office 2003 with
SP2 installed. On the new server the custom form opens fine, but it won't
populate the supervisor field. It works fine on the old term server and on
all of the desktops that are running Outlook.

Any ideas on why that one server won't work?

The form is published on the Exchange Server and we access it by going to
Tools/Choose Form and selecting it from the Organizational Forms Library.

Here's the code...it was written by a former employee:

-----------------------

Option Explicit

Const olFolderCalendar = 9
Const olOutOfOffice = 3
Const olFree = 0
Const olAppointmentItem = 1
Const olByValue = 1
Const olBCC = 3
Const olCC = 2

'Public Vacation Folder Path
Dim boolIsNew

Function Item_Open()
Dim strManager
Dim objPage
Dim objCtrl
Dim objRecip

'Stop
'Check to see if this is a new item
If Item.Size = 0 Then
boolIsNew = True

' try to get the name of my manager
strManager = GetMyManagerName()
If strManager vbNullString Then
Set objRecip = Item.Recipients.Add(strManager)
objRecip.Resolve
If objRecip.Resolved Then
Set objPage =
Item.GetInspector.ModifiedFormPages("Message")
Set objCtrl = objPage.Controls("cbToType")
objCtrl.SetFocus
End IF
End If
Else
boolIsNew = False
End If

'Stop
'Check the Approved Action
If Item.UserProperties.Find("Approved") "No Action" Then
Item.Actions.Item(5).Enabled = False
Item.Actions.Item(6).Enabled = False
End If
'MsgBox boolIsNew
End Function

Function Item_CustomAction(ByVal Action, ByVal NewItem)
Dim vacStart
Dim vacEnd
Dim toType
Dim vacHours
Dim vacComments
Dim strVacFolder
Dim hrAddress
Dim objNS
Dim vacApproverName
Dim vacApprovedName
Set objNS = Application.GetNamespace("MAPI")
'Stop
vacApproverName = objNS.CurrentUser.Name
vacApprovedName = Item.SenderName

hrAddress = "Corporate Payroll" '"Nancy Tarter" "Shane Kempton" '
strVacFolder = "Public Folders\All Public Folders\vacations"

vacStart = Item.UserProperties.Find("Vacation Start")
vacEnd = Item.UserProperties.Find("Vacation End")

toType = Item.UserProperties.Find("ToType")
vacHours = Item.UserProperties.Find("Time Off Hours")
vacComments = Item.ItemProperties.Item("Body")

Select Case Action.Name
Case "Approve"
'Make an Appointment
'Stop
Call AddAppointment(strVacFolder, vacStart, vacEnd,
toType, NewItem)

NewItem.Body = "Your time off request has been " & _
"approved: " & vbCrLf & _
"Approved For: " & vacApprovedName & vbCrLf & _
"Approved By: " & vacApproverName & vbCrLf & vbCrLf
& _
"Reason: " & toType & vbCrLf & _
"Dates: " & vacStart & " - " & vacEnd & vbCrLf & _
"Hours: " & vacHours & vbCrLf & _
"Comments: " & vacComments & vbCrLf & vbCrLf & _
"Drag the attached " & _
"Appointment to your Calendar. " & _
"Or, open it, then use File | Copy to Folder." &
vbCrLf & vbCrLf

'Send a Message to HR
Dim hr
Set hr = NewItem.Recipients.Add(hrAddress)
hr.Resolve
If hr.Resolved Then
hr.Type = olCC
End If

'Set the Approved Action
Item.UserProperties.Find("Approved") = "Approved"
Item.Save
Case "Disapprove"
'Disapprove Actions
Item.UserProperties.Find("Approved") = "Rejected"
Item.Save
Case Else
'Do Nothing
End Select
'Close the Form
Dim objInsp
Set objInsp = Item.GetInspector
objInsp.Close 2
End Function

Public Sub AddAppointment(ByVal strFolderPath,ByVal dStart,ByVal dEnd,ByVal
strSubject,ByVal NewItem)
Dim objAppt
Dim objVacFolder
Dim objAttachment

'Stop

Set objAppt = Application.CreateItem(olAppointmentItem)
With objAppt
.Start = dStart
.End = dEnd
.ReminderSet = False
.Subject = strSubject
.BusyStatus = olOutOfOffice
.Categories = Item.SenderName
.Body = "Hours: " & Item.UserProperties.Find("Time Off Hours") &
vbCrLf & _
"Comments: " & Item.ItemProperties.Item("Body")
End With

'Add the vacation as an Attachement
objAppt.Save
Set objAttachment = NewItem.Attachments.Add( _
objAppt, olByValue, , _
"Your Time Off")

'Stop

'Change a few properties on the appointment for the other calendars
objAppt.BusyStatus = olFree
objAppt.Subject = Item.SenderName & " - " & strSubject

'Add the vacation to the Approver's Calendar
Dim objMngrFolder
Dim objNS
Dim objItemCopy
Set objNS = Application.GetNamespace("MAPI")

Set objMngrFolder = objNS.GetDefaultFolder(olFolderCalendar)
Set objItemCopy = objAppt.Copy
If Not objMngrFolder Is Nothing Then
'objItemCopy.Move objMngrFolder
objItemCopy.Save
End If

'Stop

'Add the Appoinment to the Public Vacation Folder
'Set objVacFolder = GetFolder(strFolderPath)
Set objVacFolder = objNS.Folders.Item("Public
Folders").Folders.Item("All Public Folders").Folders.Item("vacations")

If Not objVacFolder Is Nothing Then
objAppt.Move objVacFolder
Else
objAppt.Delete
End If

Set objNS = Nothing
Set objItemCopy= Nothing
Set objMngrFolder = Nothing
Set objAppt = Nothing
Set objVacFolder = Nothing
Set objAttachment = Nothing
End Sub

Function GetMyManagerName()
Dim objNS
Dim objMe
Dim strName

Set objNS = Application.GetNamespace("MAPI")

Set objMe = objNS.CurrentUser
On Error Resume Next
strName = objMe.AddressEntry.Manager.Name
If Err = 0 Then
GetMyManagerName = strName
Else
GetMyManagerName = ""
End IF

Set objNS = Nothing
Set objMe = Nothing
End Function

Public Function GetFolder(strFolderPath)
Dim objNS
Dim colFolders
Dim objFolder
Dim arrFolders
Dim i

On Error Resume Next
strFolderPath = Replace(strFolderPath, "/", "\")
arrFolders = Split(strFolderPath, "\")
Set objNS = Application.GetNameSpace("MAPI")
Set objFolder = objNS.Folder.Item(arrFolders(0))

If Not objFolder Is Nothing Then
For i = 1 To UBound(arrFolders)
Set colFolders = objFolder.Folders
Set objFolder = Nothing
Set objFolder = colFolders.Item(arrFolders(i))
If objFolder Is Nothing Then
Exit For
End If
Next
End If

Set GetFolder = objFolder
Set colFolders = Nothing
Set objNS = Nothing
Set objFolder = Nothing
End Function

Function GetFolderPath(objFolder)
Dim strPath
Dim objParent
On Error Resume Next
strPath = "\" & objFolder.Name
Do While Err = 0
Set objParent = objFolder.Parent
If Err = 0 Then
strPath = "\" & objParent.Name & strPath
Set objFolder = objParent
Else
Exit Do
End If
Loop
GetFolderPath = "\" & strPath
Set objParent = Nothing
End Function

Function GetCalFolderPath()
Dim objFolder
Dim objNS
Set objNS = Application.GetNamespace("MAPI")
Set objFolder = objNS.GetDefaultFolder(olFolderCalendar)
GetCalFolderPath = GetFolderPath(objFolder)
Set objFolder = Nothing
Set objNS = Nothing
End Function

I have our programmers looking at it now. I'll keep you posted.

"Sue Mosher [MVP-Outlook]" wrote:

Did you try what I suggested earlier in your other thread -- do some diagnostics to determine more exactly what isn't working? So far all we know are symptoms? By watching the code execute, you should be able to pinpoint exactly where it is not doing what you expect. We don't even know if any of the code is running at all.

BTW, was the necessary scripting component installed on the new server? See http://support.microsoft.com/kb/302003/

--
Sue Mosher, Outlook MVP
Author of Microsoft Outlook 2007 Programming:
Jumpstart for Power Users and Administrators
http://www.outlookcode.com/article.aspx?id=54


"Eric32" wrote in message ...
We have a custom form we use for leave requests. The form has pretty basic
fields -- it allows the user to select the days and specific times and then
allows them to type a message. The "To" field is automatically populated
with their supervisor (which is pulled from Active Directory).

We're in the process of moving users from an older Windows 2003 Term Server
onto a new Windows 2003 Term Server. Both term servers have Office 2003 with
SP2 installed. On the new server the custom form opens fine, but it won't
populate the supervisor field. It works fine on the old term server and on
all of the desktops that are running Outlook.

Any ideas on why that one server won't work?

The form is published on the Exchange Server and we access it by going to
Tools/Choose Form and selecting it from the Organizational Forms Library.

Here's the code...it was written by a former employee:

-----------------------

Option Explicit

Const olFolderCalendar = 9
Const olOutOfOffice = 3
Const olFree = 0
Const olAppointmentItem = 1
Const olByValue = 1
Const olBCC = 3
Const olCC = 2

'Public Vacation Folder Path
Dim boolIsNew

Function Item_Open()
Dim strManager
Dim objPage
Dim objCtrl
Dim objRecip

'Stop
'Check to see if this is a new item
If Item.Size = 0 Then
boolIsNew = True

' try to get the name of my manager
strManager = GetMyManagerName()
If strManager vbNullString Then
Set objRecip = Item.Recipients.Add(strManager)
objRecip.Resolve
If objRecip.Resolved Then
Set objPage =
Item.GetInspector.ModifiedFormPages("Message")
Set objCtrl = objPage.Controls("cbToType")
objCtrl.SetFocus
End IF
End If
Else
boolIsNew = False
End If

'Stop
'Check the Approved Action
If Item.UserProperties.Find("Approved") "No Action" Then
Item.Actions.Item(5).Enabled = False
Item.Actions.Item(6).Enabled = False
End If
'MsgBox boolIsNew
End Function

Function Item_CustomAction(ByVal Action, ByVal NewItem)
Dim vacStart
Dim vacEnd
Dim toType
Dim vacHours
Dim vacComments
Dim strVacFolder
Dim hrAddress
Dim objNS
Dim vacApproverName
Dim vacApprovedName
Set objNS = Application.GetNamespace("MAPI")
'Stop
vacApproverName = objNS.CurrentUser.Name
vacApprovedName = Item.SenderName

hrAddress = "Corporate Payroll" '"Nancy Tarter" "Shane Kempton" '
strVacFolder = "Public Folders\All Public Folders\vacations"

vacStart = Item.UserProperties.Find("Vacation Start")
vacEnd = Item.UserProperties.Find("Vacation End")

toType = Item.UserProperties.Find("ToType")
vacHours = Item.UserProperties.Find("Time Off Hours")
vacComments = Item.ItemProperties.Item("Body")

Select Case Action.Name
Case "Approve"
'Make an Appointment
'Stop
Call AddAppointment(strVacFolder, vacStart, vacEnd,
toType, NewItem)

NewItem.Body = "Your time off request has been " & _
"approved: " & vbCrLf & _
"Approved For: " & vacApprovedName & vbCrLf & _
"Approved By: " & vacApproverName & vbCrLf & vbCrLf
& _
"Reason: " & toType & vbCrLf & _
"Dates: " & vacStart & " - " & vacEnd & vbCrLf & _
"Hours: " & vacHours & vbCrLf & _
"Comments: " & vacComments & vbCrLf & vbCrLf & _
"Drag the attached " & _
"Appointment to your Calendar. " & _
"Or, open it, then use File | Copy to Folder." &
vbCrLf & vbCrLf

'Send a Message to HR
Dim hr
Set hr = NewItem.Recipients.Add(hrAddress)
hr.Resolve
If hr.Resolved Then
hr.Type = olCC
End If

'Set the Approved Action
Item.UserProperties.Find("Approved") = "Approved"
Item.Save
Case "Disapprove"
'Disapprove Actions
Item.UserProperties.Find("Approved") = "Rejected"
Item.Save
Case Else
'Do Nothing
End Select
'Close the Form
Dim objInsp
Set objInsp = Item.GetInspector
objInsp.Close 2
End Function

Public Sub AddAppointment(ByVal strFolderPath,ByVal dStart,ByVal dEnd,ByVal
strSubject,ByVal NewItem)
Dim objAppt
Dim objVacFolder
Dim objAttachment

'Stop

Set objAppt = Application.CreateItem(olAppointmentItem)
With objAppt
.Start = dStart
.End = dEnd
.ReminderSet = False
.Subject = strSubject
.BusyStatus = olOutOfOffice
.Categories = Item.SenderName
.Body = "Hours: " & Item.UserProperties.Find("Time Off Hours") &
vbCrLf & _
"Comments: " & Item.ItemProperties.Item("Body")
End With

'Add the vacation as an Attachement
objAppt.Save
Set objAttachment = NewItem.Attachments.Add( _
objAppt, olByValue, , _
"Your Time Off")

'Stop

'Change a few properties on the appointment for the other calendars
objAppt.BusyStatus = olFree
objAppt.Subject = Item.SenderName & " - " & strSubject

'Add the vacation to the Approver's Calendar
Dim objMngrFolder
Dim objNS
Dim objItemCopy
Set objNS = Application.GetNamespace("MAPI")

Set objMngrFolder = objNS.GetDefaultFolder(olFolderCalendar)
Set objItemCopy = objAppt.Copy
If Not objMngrFolder Is Nothing Then
'objItemCopy.Move objMngrFolder
objItemCopy.Save
End If

'Stop

'Add the Appoinment to the Public Vacation Folder
'Set objVacFolder = GetFolder(strFolderPath)
Set objVacFolder = objNS.Folders.Item("Public
Folders").Folders.Item("All Public Folders").Folders.Item("vacations")

If Not objVacFolder Is Nothing Then
objAppt.Move objVacFolder
Else
objAppt.Delete
End If

Set objNS = Nothing
Set objItemCopy= Nothing
Set objMngrFolder = Nothing
Set objAppt = Nothing
Set objVacFolder = Nothing
Set objAttachment = Nothing
End Sub

Function GetMyManagerName()
Dim objNS
Dim objMe
Dim strName

Set objNS = Application.GetNamespace("MAPI")

Set objMe = objNS.CurrentUser
On Error Resume Next
strName = objMe.AddressEntry.Manager.Name
If Err = 0 Then
GetMyManagerName = strName
Else
GetMyManagerName = ""
End IF

Set objNS = Nothing
Set objMe = Nothing
End Function

Public Function GetFolder(strFolderPath)
Dim objNS
Dim colFolders
Dim objFolder
Dim arrFolders
Dim i

On Error Resume Next
strFolderPath = Replace(strFolderPath, "/", "\")
arrFolders = Split(strFolderPath, "\")
Set objNS = Application.GetNameSpace("MAPI")
Set objFolder = objNS.Folder.Item(arrFolders(0))

If Not objFolder Is Nothing Then
For i = 1 To UBound(arrFolders)
Set colFolders = objFolder.Folders
Set objFolder = Nothing
Set objFolder = colFolders.Item(arrFolders(i))
If objFolder Is Nothing Then
Exit For
End If
Next
End If

Set GetFolder = objFolder
Set colFolders = Nothing
Set objNS = Nothing
Set objFolder = Nothing
End Function

Function GetFolderPath(objFolder)
Dim strPath
Dim objParent
On Error Resume Next
strPath = "\" & objFolder.Name
Do While Err = 0
Set objParent = objFolder.Parent
If Err = 0 Then
strPath = "\" & objParent.Name & strPath
Set objFolder = objParent
Else
Exit Do
End If
Loop
GetFolderPath = "\" & strPath
Set objParent = Nothing
End Function

Function GetCalFolderPath()
Dim objFolder
Dim objNS
Set objNS = Application.GetNamespace("MAPI")
Set objFolder = objNS.GetDefaultFolder(olFolderCalendar)
GetCalFolderPath = GetFolderPath(objFolder)
Set objFolder = Nothing
Set objNS = Nothing
End Function

Hi Sue -- sorry for the delayed response -- here's a message from one of our
programmers. Thanks for your help!!!

It’s fixed now. I had to copy outlvbs.dll from Wheeler to Longstreet.
Found that advice on the link below referring to Outlook 2002, but it looks
like it still applies to Outlook 2003 too. This is from the lady that wrote
the book we used – Sue Mosher. Eric, is that who was helping you on the
forums?

http://www.slipstick.com/config/terminalserver.htm


"Sue Mosher [MVP-Outlook]" wrote:

Did you try what I suggested earlier in your other thread -- do some diagnostics to determine more exactly what isn't working? So far all we know are symptoms? By watching the code execute, you should be able to pinpoint exactly where it is not doing what you expect. We don't even know if any of the code is running at all.

BTW, was the necessary scripting component installed on the new server? See http://support.microsoft.com/kb/302003/

--
Sue Mosher, Outlook MVP
Author of Microsoft Outlook 2007 Programming:
Jumpstart for Power Users and Administrators
http://www.outlookcode.com/article.aspx?id=54


"Eric32" wrote in message ...
We have a custom form we use for leave requests. The form has pretty basic
fields -- it allows the user to select the days and specific times and then
allows them to type a message. The "To" field is automatically populated
with their supervisor (which is pulled from Active Directory).

We're in the process of moving users from an older Windows 2003 Term Server
onto a new Windows 2003 Term Server. Both term servers have Office 2003 with
SP2 installed. On the new server the custom form opens fine, but it won't
populate the supervisor field. It works fine on the old term server and on
all of the desktops that are running Outlook.

Any ideas on why that one server won't work?

The form is published on the Exchange Server and we access it by going to
Tools/Choose Form and selecting it from the Organizational Forms Library.

Here's the code...it was written by a former employee:

-----------------------

Option Explicit

Const olFolderCalendar = 9
Const olOutOfOffice = 3
Const olFree = 0
Const olAppointmentItem = 1
Const olByValue = 1
Const olBCC = 3
Const olCC = 2

'Public Vacation Folder Path
Dim boolIsNew

Function Item_Open()
Dim strManager
Dim objPage
Dim objCtrl
Dim objRecip

'Stop
'Check to see if this is a new item
If Item.Size = 0 Then
boolIsNew = True

' try to get the name of my manager
strManager = GetMyManagerName()
If strManager vbNullString Then
Set objRecip = Item.Recipients.Add(strManager)
objRecip.Resolve
If objRecip.Resolved Then
Set objPage =
Item.GetInspector.ModifiedFormPages("Message")
Set objCtrl = objPage.Controls("cbToType")
objCtrl.SetFocus
End IF
End If
Else
boolIsNew = False
End If

'Stop
'Check the Approved Action
If Item.UserProperties.Find("Approved") "No Action" Then
Item.Actions.Item(5).Enabled = False
Item.Actions.Item(6).Enabled = False
End If
'MsgBox boolIsNew
End Function

Function Item_CustomAction(ByVal Action, ByVal NewItem)
Dim vacStart
Dim vacEnd
Dim toType
Dim vacHours
Dim vacComments
Dim strVacFolder
Dim hrAddress
Dim objNS
Dim vacApproverName
Dim vacApprovedName
Set objNS = Application.GetNamespace("MAPI")
'Stop
vacApproverName = objNS.CurrentUser.Name
vacApprovedName = Item.SenderName

hrAddress = "Corporate Payroll" '"Nancy Tarter" "Shane Kempton" '
strVacFolder = "Public Folders\All Public Folders\vacations"

vacStart = Item.UserProperties.Find("Vacation Start")
vacEnd = Item.UserProperties.Find("Vacation End")

toType = Item.UserProperties.Find("ToType")
vacHours = Item.UserProperties.Find("Time Off Hours")
vacComments = Item.ItemProperties.Item("Body")

Select Case Action.Name
Case "Approve"
'Make an Appointment
'Stop
Call AddAppointment(strVacFolder, vacStart, vacEnd,
toType, NewItem)

NewItem.Body = "Your time off request has been " & _
"approved: " & vbCrLf & _
"Approved For: " & vacApprovedName & vbCrLf & _
"Approved By: " & vacApproverName & vbCrLf & vbCrLf
& _
"Reason: " & toType & vbCrLf & _
"Dates: " & vacStart & " - " & vacEnd & vbCrLf & _
"Hours: " & vacHours & vbCrLf & _
"Comments: " & vacComments & vbCrLf & vbCrLf & _
"Drag the attached " & _
"Appointment to your Calendar. " & _
"Or, open it, then use File | Copy to Folder." &
vbCrLf & vbCrLf

'Send a Message to HR
Dim hr
Set hr = NewItem.Recipients.Add(hrAddress)
hr.Resolve
If hr.Resolved Then
hr.Type = olCC
End If

'Set the Approved Action
Item.UserProperties.Find("Approved") = "Approved"
Item.Save
Case "Disapprove"
'Disapprove Actions
Item.UserProperties.Find("Approved") = "Rejected"
Item.Save
Case Else
'Do Nothing
End Select
'Close the Form
Dim objInsp
Set objInsp = Item.GetInspector
objInsp.Close 2
End Function

Public Sub AddAppointment(ByVal strFolderPath,ByVal dStart,ByVal dEnd,ByVal
strSubject,ByVal NewItem)
Dim objAppt
Dim objVacFolder
Dim objAttachment

'Stop

Set objAppt = Application.CreateItem(olAppointmentItem)
With objAppt
.Start = dStart
.End = dEnd
.ReminderSet = False
.Subject = strSubject
.BusyStatus = olOutOfOffice
.Categories = Item.SenderName
.Body = "Hours: " & Item.UserProperties.Find("Time Off Hours") &
vbCrLf & _
"Comments: " & Item.ItemProperties.Item("Body")
End With

'Add the vacation as an Attachement
objAppt.Save
Set objAttachment = NewItem.Attachments.Add( _
objAppt, olByValue, , _
"Your Time Off")

'Stop

'Change a few properties on the appointment for the other calendars
objAppt.BusyStatus = olFree
objAppt.Subject = Item.SenderName & " - " & strSubject

'Add the vacation to the Approver's Calendar
Dim objMngrFolder
Dim objNS
Dim objItemCopy
Set objNS = Application.GetNamespace("MAPI")

Set objMngrFolder = objNS.GetDefaultFolder(olFolderCalendar)
Set objItemCopy = objAppt.Copy
If Not objMngrFolder Is Nothing Then
'objItemCopy.Move objMngrFolder
objItemCopy.Save
End If

'Stop

'Add the Appoinment to the Public Vacation Folder
'Set objVacFolder = GetFolder(strFolderPath)
Set objVacFolder = objNS.Folders.Item("Public
Folders").Folders.Item("All Public Folders").Folders.Item("vacations")

If Not objVacFolder Is Nothing Then
objAppt.Move objVacFolder
Else
objAppt.Delete
End If

Set objNS = Nothing
Set objItemCopy= Nothing
Set objMngrFolder = Nothing
Set objAppt = Nothing
Set objVacFolder = Nothing
Set objAttachment = Nothing
End Sub

Function GetMyManagerName()
Dim objNS
Dim objMe
Dim strName

Set objNS = Application.GetNamespace("MAPI")

Set objMe = objNS.CurrentUser
On Error Resume Next
strName = objMe.AddressEntry.Manager.Name
If Err = 0 Then
GetMyManagerName = strName
Else
GetMyManagerName = ""
End IF

Set objNS = Nothing
Set objMe = Nothing
End Function

Public Function GetFolder(strFolderPath)
Dim objNS
Dim colFolders
Dim objFolder
Dim arrFolders
Dim i

On Error Resume Next
strFolderPath = Replace(strFolderPath, "/", "\")
arrFolders = Split(strFolderPath, "\")
Set objNS = Application.GetNameSpace("MAPI")
Set objFolder = objNS.Folder.Item(arrFolders(0))

If Not objFolder Is Nothing Then
For i = 1 To UBound(arrFolders)
Set colFolders = objFolder.Folders
Set objFolder = Nothing
Set objFolder = colFolders.Item(arrFolders(i))
If objFolder Is Nothing Then
Exit For
End If
Next
End If

Set GetFolder = objFolder
Set colFolders = Nothing
Set objNS = Nothing
Set objFolder = Nothing
End Function

Function GetFolderPath(objFolder)
Dim strPath
Dim objParent
On Error Resume Next
strPath = "\" & objFolder.Name
Do While Err = 0
Set objParent = objFolder.Parent
If Err = 0 Then
strPath = "\" & objParent.Name & strPath
Set objFolder = objParent
Else
Exit Do
End If
Loop
GetFolderPath = "\" & strPath
Set objParent = Nothing
End Function

Function GetCalFolderPath()
Dim objFolder
Dim objNS
Set objNS = Application.GetNamespace("MAPI")
Set objFolder = objNS.GetDefaultFolder(olFolderCalendar)
GetCalFolderPath = GetFolderPath(objFolder)
Set objFolder = Nothing
Set objNS = Nothing
End Function