Excel to shared calendar macro

[Garouken2]

Hello I am in desperate need of some help! please take a look at the following code that works for putting appointments into my own default calendar in outlook, however I require it to input to a shared calendar. I have looked all over and found the Dim outlook.folder but I keep getting compile error I know the code below isn't clean but any help would be greatly appreciated


if this helps the shared calendar is in "all public folders/workforce admin/WFD/WFD Adults"

Sub Appointments()
 Const olAppointmentItem As Long = 1
 Dim oApp As Object

 Dim OLNS As Object
 Dim oAppt As Object
‘Dim oFolder As Outlook.Folder

 

 On Error Resume Next
 Set oApp = GetObject(, “Outlook.Application”)
 If oApp Is Nothing Then Set oApp = CreateObject(“Outlook.Application”)
 On Error GoTo 0

 If Not oApp Is Nothing Then
 
 Set OLNS = oApp.GetNamespace(“MAPI”)
 OLNS.Logon


‘Set oFolder = oNamespace.GetDefaultFolder(olPublicFoldersAllPublicFolders)
‘Set oFolder = oFolder.Folders(“Workforce Admin”)
‘Set oFolder = oFolder.Folders(“WFD”)
‘Set oFolder = oFolder.Folders(“WFD Adults”)

 Set oAppt = oApp.CreateItem(olAppointmentItem)
 oAppt.Subject = Range(“A2”).Value
 oAppt.Start = Range(“b2”).Value
 oAppt.Duration = Range(“c2”).Value
  oAppt.Save



 

 Set OLAppointment = Nothing
 Set OLNS = Nothing
 Set oApp = Nothing
 End If

 End Sub

[cytop]

As you seem to be using Late Binding, oFolder should be declared as an Object. 'Outlook.Folder' means nothing unless you have a references set to the Outlook Object model (Early Binding).

You will also need to define other constants (olPublicFoldersAllPublicFolders, for example) which are defined in Outlook, exactly the same as you have done for olAppointmentItem

[Garouken2]

I am really sorry but I am completely out of my depth here I cant seem to implement the changes you suggested

[cytop]

What have you tried...?

Declare oFolder as type Object
Define a constant for olPublicFoldersAllPublicFolders

You'll find the enumerations for Outlook folders here. Define a constant, same as olAppointmentItem, for olPublicFoldersAllPublicFolders using the appropriate value from that list.

If there are any other ol... variables in code you haven't posted then they need to be defined as well.

[Garouken2]

Hi this is what I have

Sub Appointments()
 Const olAppointmentItem As Long = 1
 Const olPublicFoldersAllPublicFolders As Long = 18
 Dim oApp As Object
 Dim OLNS As Object
 Dim oAppt As Object
Dim oFolder As Object





 On Error Resume Next
 Set oApp = GetObject(, "Outlook.Application")
 If oApp Is Nothing Then Set oApp = CreateObject("Outlook.Application")
 On Error GoTo 0

 If Not oApp Is Nothing Then
 
 Set OLNS = oApp.GetNamespace("MAPI")
 OLNS.Logon

 Set oAppt = oApp.CreateItem(olAppointmentItem)
 oAppt.Subject = Range("A2").Value
 oAppt.Start = Range("b2").Value
 oAppt.Duration = Range("c2").Value
  oAppt.Save


Set oFolder = oNamespace.GetDefaultFolder(olPublicFoldersAllPublicFolders)
Set oFolder = oFolder.Folders("Workforce Admin")
Set oFolder = oFolder.Folders("WFD")
Set oFolder = oFolder.Folders("WFD Adults")




 Set OLAppointment = Nothing
 Set OLNS = Nothing
 Set oApp = Nothing
 End If

 End Sub

[cytop]

You have an oNameSpace object which is never assigned a value - at a guess this should be OLNS rather than oNameSpace.

I didn't look at the code except for the obvious issues mentioned in your first post but the code adds an appointment to the default calendar and then gets a reference to to the folder WFD Adults... but doesn't do anything. You need to rejig the code - get the reference to the folder then add the appointment.

You might find a reply from yesterday in another thread helpful: http://www.excelforum.com/excel-prog...ml#post4588280

[Garouken2]

managed to sort it using a different way of linking to the calendar code attached for benefit of anyone else looking this up

Sub Write_to_specific_calendar()
    Dim oApp As Object
    Dim oNameSpace As Namespace
    Dim oFolder As Object
     
    Set oApp = New Outlook.Application
    Set oNameSpace = oApp.GetNamespace("MAPI")
    Set oFolder = oNameSpace.GetFolderFromID("000000001A447390AA6611CD9BC800AA002FC45A0300DB07FE0F96276242BAA5C60B8079B47700019E7AFDB20000")
     
    With oFolder
         
        Set olApt = oApp.CreateItem(olAppointmentItem)
        With olApt
            .Start = Range("B2").Value
            .Subject = Range("A2").Value
            .Location = Range("D2").Value
            .Body = Range("E2").Value
            .BusyStatus = olFree
            .ReminderMinutesBeforeStart = 0
            .Duration = Range("C2").Value
            .Save
            .Move oFolder
        End With
        Set olNS = Nothing
        Set olApp = Nothing
        Set olApt = Nothing
         
         
    End With
     
End Sub

Thank you for all your help and I greatly appreciate your time