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 "To" field is automatically populated
with their supervisor (which is pulled from Active Directory).

Automatically how? Through code behind the form? If so, please show it. Also, where is the form published?
--
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?

Here's the code -- this was created by one of our former employees:

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

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



"Sue Mosher [MVP-Outlook]" wrote:

The "To" field is automatically populated
with their supervisor (which is pulled from Active Directory).

Automatically how? Through code behind the form? If so, please show it. Also, where is the form published?
--
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?

I would suggest that you sprinkle a few MsgBox statements in the Item_Open and GetMyManager name procedures to try to get a handle on what code statements are actually being executed and what values are being returned to variables. Or put in a Stop statement and invoke the script debugger to step through the code.

You still didn't say where the form was published.

--
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 ...
Here's the code -- this was created by one of our former employees:

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

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



"Sue Mosher [MVP-Outlook]" wrote:

The "To" field is automatically populated
with their supervisor (which is pulled from Active Directory).

Automatically how? Through code behind the form? If so, please show it. Also, where is the form published?
--
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?

Sorry about that. The form is published on our Exchange Server. It shows up
under Organizational Forms Library when we go to Tools/Choose Form within
Outlook. I hope that's what you're looking for.

"Sue Mosher [MVP-Outlook]" wrote:

I would suggest that you sprinkle a few MsgBox statements in the Item_Open and GetMyManager name procedures to try to get a handle on what code statements are actually being executed and what values are being returned to variables. Or put in a Stop statement and invoke the script debugger to step through the code.

You still didn't say where the form was published.

--
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 ...
Here's the code -- this was created by one of our former employees:

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

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



"Sue Mosher [MVP-Outlook]" wrote:

The "To" field is automatically populated
with their supervisor (which is pulled from Active Directory).

Automatically how? Through code behind the form? If so, please show it. Also, where is the form published?
--
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

Yes, that's always useful information when dealing with custom forms. Let us know what else you find out.

FYI, there is a newsgroup specifically for Outlook forms issues "down the hall" at microsoft.public.outlook.program_forms or, via web interface, at http://www.microsoft.com/office/comm...rogram_f orms

--
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 ...
Sorry about that. The form is published on our Exchange Server. It shows up
under Organizational Forms Library when we go to Tools/Choose Form within
Outlook. I hope that's what you're looking for.

"Sue Mosher [MVP-Outlook]" wrote:

I would suggest that you sprinkle a few MsgBox statements in the Item_Open and GetMyManager name procedures to try to get a handle on what code statements are actually being executed and what values are being returned to variables. Or put in a Stop statement and invoke the script debugger to step through the code.

You still didn't say where the form was published.

"Eric32" wrote in message ...
Here's the code -- this was created by one of our former employees:

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

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



"Sue Mosher [MVP-Outlook]" wrote:

The "To" field is automatically populated
with their supervisor (which is pulled from Active Directory).

Automatically how? Through code behind the form? If so, please show it. Also, where is the form published?
--
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

Hi Sue,

I posted this in the other newsgroup but wanted to post it here as well.
This was a message from one of our programming guys. 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:

Yes, that's always useful information when dealing with custom forms. Let us know what else you find out.

FYI, there is a newsgroup specifically for Outlook forms issues "down the hall" at microsoft.public.outlook.program_forms or, via web interface, at http://www.microsoft.com/office/comm...rogram_f orms

--
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 ...
Sorry about that. The form is published on our Exchange Server. It shows up
under Organizational Forms Library when we go to Tools/Choose Form within
Outlook. I hope that's what you're looking for.

"Sue Mosher [MVP-Outlook]" wrote:

I would suggest that you sprinkle a few MsgBox statements in the Item_Open and GetMyManager name procedures to try to get a handle on what code statements are actually being executed and what values are being returned to variables. Or put in a Stop statement and invoke the script debugger to step through the code.

You still didn't say where the form was published.

"Eric32" wrote in message ...
Here's the code -- this was created by one of our former employees:

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

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



"Sue Mosher [MVP-Outlook]" wrote:

The "To" field is automatically populated
with their supervisor (which is pulled from Active Directory).

Automatically how? Through code behind the form? If so, please show it. Also, where is the form published?