Hi Sue:
I figure I better include the code so you can see
everything that it is doing.
Option Explicit
Dim mstrVacFolder ' public Vacations folder
full path
Const olOutOfOffice = 3
Const olAppointmentItem = 1
Const olByValue = 1
Const olFolderCalendar = 9
Sub InitOpts()
' set user options
'public Vacations folder name and path
mstrVacFolder = "Public Folders/All Public
Folders/Departmental Folders/PlantOps/Network Services/NS-
OutOfOffice Calendar"
End Sub
Function Item_Open()
Dim objPage
Dim objCtrl
Dim objRecip
Dim strManager
Dim strFolderPath
Call InitOpts()
Set objPage = Item.GetInspector.ModifiedFormPages
("Vacations")
Set objCtrl = objPage.Controls("OVCtl1")
If Item.Size = 0 Then
' show user Calendar in view control
With objCtrl
.Folder = GetCalFolder()
.View = "Day/Week/Month"
' .Restriction = "[Subject] = ""Vacation"""
End With
' try to get the name of my manager
strManager = GetMyManagerName()
If strManager <> vbNullString Then
Set objRecip = Item.Recipients.Add(strManager)
objRecip.Resolve
' skip straight to Vacation Start field if we
have the manager
If objRecip.Resolved Then
Set objPage =
Item.GetInspector.ModifiedFormPages("Message")
Set objCtrl = objPage.Controls
("txtVacStart")
objCtrl.SetFocus
End IF
End If
Else
With objCtrl
' show public Vacations folder in view control
.Folder = "\" & Replace(mstrVacFolder,"/","\")
.View = "Day/Week/Month" ' name of custom
view
End With
End If
Set objPage = Nothing
Set objCtrl = Nothing
Set objRecip = Nothing
End Function
Function Item_CustomAction(ByVal Action, ByVal NewItem)
Dim objAppt
Dim objAttachment
Dim objFolder
Dim dteStart
Dim dteEnd
Select Case Action.Name
Case "Approve"
' create appointment for user to save to
calendar
dteStart = _
Item.UserProperties("VacationStart")
dteEnd = _
Item.UserProperties("VacationEnd")
Set objAppt = _
Application.CreateItem(olAppointmentItem)
With objAppt
.Start = dteStart
.End = dteEnd
.ReminderSet = False
.Subject = "Vacation"
.AllDayEvent = True
.BusyStatus = olOutOfOffice
End With
objAppt.Save
Set objAttachment = NewItem.Attachments.Add( _
objAppt, olByValue, , _
"Your Vacation")
NewItem.Body = "Your vacation has been " & _
"approved. Drag the attached "
& _
"Appointment to your
Calendar. " & _
"Or, open it, then use File |
Copy to Folder." _
& vbCrLf & vbCrLf
' move appointment to public folder
objAppt.Subject = Item.SenderName & " -
Vacation"
Set objFolder = GetMAPIFolder(mstrVacFolder)
If Not objFolder Is Nothing Then
objAppt.Move objFolder
End If
Case Else
'do nothing special for other actions
End Select
' dereference objects
Set objAppt = Nothing
Set objAttachment = Nothing
Set objFolder = Nothing
End Function
Function GetMAPIFolder(strName)
Dim objApp
Dim objNS
Dim objFolder
Dim objFolders
Dim arrName
Dim objExpl
Dim I
Dim blnFound
Set objApp = Application
Set objNS = objApp.GetNamespace("MAPI")
arrName = Split(strName, "/")
Set objFolders = objNS.Folders
blnFound = False
For I = 0 To UBound(arrName)
For Each objFolder In objFolders
If objFolder.Name = arrName(I) Then
Set objFolders = objFolder.Folders
blnFound = True
Exit For
Else
blnFound = False
End If
Next
If blnFound = False Then
Exit For
End If
Next
If blnFound = True Then
Set GetMAPIFolder = objFolder
Else
Set GetMAPIFolder = Nothing
End If
Set objApp = Nothing
Set objNS = Nothing
Set objFolder = Nothing
Set objFolders = Nothing
Set objExpl = Nothing
End Function
Function GetFolderPath(objFolder)
' from Randy Byrne, Building Applications with Outlook 2000
On Error Resume Next
Dim strFolderPath
Dim objChild
Dim objParent
strFolderPath = "\" & objFolder.Name
Set objChild = objFolder
Do Until Err <> 0
Set objParent = objChild.Parent
If Err <> 0 Then
Exit Do
End If
strFolderPath = "\" & objParent.Name &
strFolderPath
Set objChild = objParent
Loop
GetFolderPath = strFolderPath
Set objChild = Nothing
Set objParent = Nothing
End Function
Function GetCalFolder()
Dim objFolder
Dim objNS
Set objNS = Application.GetNamespace("MAPI")
Set objFolder = objNS.GetDefaultFolder
(olFolderCalendar)
GetCalFolder = GetFolderPath(objFolder)
Set objFolder = Nothing
Set objNS = Nothing
End Function
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
Thank you,
-----Original Message-----
Does the script contain the GetCalFolder() function? What value does it
return? Have you tried stepping through it in the debugger?
--
Sue Mosher, Outlook MVP
Author of
Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers
[email protected]...
The form is published in the organizational forms library
and the "send form definition with item" is unchecked.
The script debugger points to the ".Folder" line.
With objCtrl
.Folder = GetCalFolder()
.View = "Day/Week/Month"
.Restriction = "[Subject] = ""Vacation"""
End With
If I open the form using Outlook 2000 it works fine, but
it doesn't using Outlook 2003. They are using Exchange
2000. Could that be the cause?
-----Original Message-----
Where did you publish the form? Did you leave the "send
form definition with
item" box unchecked?
I am trying to run the vacation request form on Outlook
2003 but it doesn't work, it works fine in Outlook 2000.
I cannot see the calendars or write to the calendar
when I
run the form. Also, it doesn't write to the Public
folder
calendar.
Did the view control changed somehow in Outlook 2003?
.
