Excel: Import Excel Info into Outlook

I want to transfer information that's in an Excel spreadsheet into a calendar in outlook. I've written the code below to create new appointments but the appointments are created in my main calendar. How do I direct them to be written in another calendar named Schedule in my mailbox or into a calendar that is in a public folder. The preferred option would be a public folder with the following tree:

\\Public Folders\All Public Folders\Tech Schedule\

Here is the code that has been written:



Sub AddAppointments()


' Create the Outlook session

Set myOutlook = CreateObject("Outlook.Application")

' Start at row 2
r = 2

Do Until Trim(Cells(r, 1).Value) = ""
' Create the AppointmentItem
Set myApt = myOutlook.createitem(1)
' Set the appointment properties
myApt.Subject = Cells(r, 1).Value
myApt.Location = Cells(r, 2).Value
myApt.Start = Cells(r, 3).Value
myApt.Duration = Cells(r, 4).Value
' If Busy Status is not specified, default to 2 (Busy)
If Trim(Cells(r, 5).Value) = "" Then
myApt.BusyStatus = 2
Else
myApt.BusyStatus = Cells(r, 5).Value
End If
If Cells(r, 6).Value > 0 Then
myApt.ReminderSet = True
myApt.ReminderMinutesBeforeStart = Cells(r, 6).Value
Else
myApt.ReminderSet = False
End If
myApt.Body = Cells(r, 7).Value
myApt.Save
r = r + 1
Loop
End Sub

Thanks in advance for the help!

code or highlight tags would be nice

vb Code:

Sub AddAppointments()
 
 
' Create the Outlook session
 
Set myOutlook = CreateObject("Outlook.Application")
 
' Start at row 2
r = 2
 
Do Until Trim(Cells(r, 1).Value) = ""
' Create the AppointmentItem
Set myApt = myOutlook.createitem(1)
' Set the appointment properties
myApt.Subject = Cells(r, 1).Value
myApt.Location = Cells(r, 2).Value
myApt.Start = Cells(r, 3).Value
myApt.Duration = Cells(r, 4).Value
' If Busy Status is not specified, default to 2 (Busy)
If Trim(Cells(r, 5).Value) = "" Then
myApt.BusyStatus = 2
Else
myApt.BusyStatus = Cells(r, 5).Value
End If
If Cells(r, 6).Value > 0 Then
myApt.ReminderSet = True
myApt.ReminderMinutesBeforeStart = Cells(r, 6).Value
Else
myApt.ReminderSet = False
End If
myApt.Body = Cells(r, 7).Value
myApt.Save
r = r + 1
Loop
End Sub

I'm just starting out writing VBA so please be patient with me. Let me revise this to code that creates a single appointment. Need to direct creation of this appointment to a calendar that is in a public folder not my current mailbox calendar.

Code:

---

1. Sub AddAppointments()
2. ' Create the Outlook session
3. Set myOutlook = CreateObject("Outlook.Application")
4. ' Create the AppointmentItem
5. Set myApt = myOutlook.createitem(1)
6. ' Set the appointment properties
7. myApt.Subject = "Matt"
8. myApt.Location = "Office"
9. myApt.Start = "4/27/2011  12:00:00 PM"
10. myApt.Duration = "30"
11. myApt.BusyStatus = 2
12. myApt.ReminderSet = True
13. myApt.ReminderMinutesBeforeStart = "0"
14. myApt.ReminderSet = False
15. myApt.Body = "Meeting With Boss"
16. myApt.Save
17. End Sub

---

I appreciate any assistance that you can provide.

as i do not have outlook installed, i can not be sure how to get the correct folder object