[Sporadic]

Thank you Zack!! So, instead of just posting what's going on I went in and messed around a bit. It is giving me the error in the If statement as if it can't find the calendar. And it is not writing to any calendar.

'Code to access another calender (folder)
Set olFolder = olApp.Session.GetDefaultFolder(olFolderCalendar)
On Error Resume Next
Set olSubfolder = olFolder.Folders(sCalendar)
If olSubfolder Is Nothing Then
'an error occured
MsgBox "An error occured attempting that Calendar!", vbExclamation, "ERROR!"
'do whatever you want
End If
Set olApt = olSubfolder.Items.Add

So, what I did was change the first Set olFolder to Set olSubfolder now when I do that it no longer gives me the error however, it just writes to my calendar. I have been playing with it for a while I am confused as to how to make it target the sCalendar I know it is very close to being right. Thanks again for the help!

[Zack Barresse]

Do you have permissions to Add to that calendar? That would be the first thing I would check. Then make sure that variable is actually getting set to the right calendar. Can you step through your code (ensure you have the Locals window showing, from the View menu in the VBE) and look at your variables?

[Sporadic]

I have premissions for sure to write to the calendar. When I check with the Locals Window showing it says:

Expression |Value | Type
olFolder | Nothing | MAPIFolder
olSubfolder | Nothing | MAPIFolder
olApt | Nothing | AppointmentItem
SCalendar | "Stations Estimates"(correct) | String
blnCreated | False | Boolean
x | Empty | Variant/Empty
LastRow | 2 | Long


Is that what you were looking for??

[Sporadic]

Alright, So according to the Locals Window olFolder and olSubfolder are = nothing which is not good I don't think. I think the first Set olFolder is to get into the directory of Outlook(don't know any other way to say that) and the second Set olFolder is to target a sub directory within the outlook directory(should be my shared calendar). But no matter how I change the code trying to get the subfolder to target anything I have been unsucessful. I have tried changing
Set olFolder = olApp.Session.GetDefaultFolder(olFolderCalendar)
to
Set olFolder = olApp.Session.GetSharedDefaultFolder(olFolderCalendar)
But it keeps giving me errors and I have tried a bunch of different options in the brackets at the end of the shareddefault folder. I think if I can get that line working the other one should work too. Any suggestions as to how I can do that? Or am I waaaay off?

[Zack Barresse]

I've tested this on multiple calendars and it works just fine. The only thing I cannot test on here is an actual Shared Calendar. So ensure you permissions are exactly where you want them (i.e. having write access).

I changed it up a bit. Having users type in calendar names just, well, it sucks. Users are ALWAYS prone to error. So I used your UserForm1, added a combo box, and populated it with all of the calendars found in the instance of Outlook. If it's listed in the combobox, it's a viable calendar to write to (again, assuming permissions).

I also put the bulk of the code into a standard module...

Option Explicit

Public olApp As Outlook.Application
    
Public Sub ExportAppointmentsToOutlook(sCalName As String)

    Dim olFolder As Outlook.MAPIFolder      '**
    Dim olSubfolder As Outlook.MAPIFolder   '**
    Dim olApt As Outlook.AppointmentItem    '*
    Dim sCalendar As String                 '**
    Dim blnCreated As Boolean
    Dim x As Variant, LastRow As Long, ws As Worksheet
    
'Read the table with appointments:
    If olApp Is Nothing Then
        On Error Resume Next
        Set olApp = GetObject(, "Outlook.Application")
        If olApp Is Nothing Then
            Set olApp = CreateObject("Outlook.Application")
            blnCreated = True
            Err.Clear
        Else
            blnCreated = False
        End If
        On Error GoTo 0
    End If

    Set ws = ActiveWorkbook.ActiveSheet     '*
    
    With ws.Range("A2:B" & ws.Rows.Count)
        If WorksheetFunction.CountA(.Cells) = 0 Then
            LastRow = 0 'you don't REALLY need this line, since it'll already be zero..
        Else
            LastRow = .Find(What:="*", after:=.Cells(1, 1), LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        End If
    End With
    
    If LastRow = 0 Then GoTo ExitEarly

'    sCalendar = InputBox("Calendar Name Please")
    
    'Code to access another calender (folder)
    Set olFolder = olApp.Session.GetDefaultFolder(olFolderCalendar)
    On Error Resume Next
    Set olSubfolder = olFolder.Folders(sCalName)
    If olSubfolder Is Nothing Then
        'an error occured
        MsgBox "An error occured attempting that Calendar!", vbExclamation, "ERROR!"
        'do whatever you want
    End If

    For x = 2 To LastRow
'        Set olApt = olSubfolder.Items.Add 'moved line
        Set olApt = olSubfolder.Items.Add(olAppointmentItem)
        With olApt
            .Start = ws.Range("B" & x).Value
            .End = ws.Range("C" & x).Value
            .Subject = ws.Range("A" & x).Value
            .Location = ws.Range("D" & x).Value
            .BusyStatus = olBusy
            .ReminderSet = False
            .AllDayEvent = True
            .Save
'            .Close
        End With
    Next x

ExitEarly:

    If blnCreated = True Then olApp.Quit    '*
    
    Set olApt = Nothing
    Set olApp = Nothing

End Sub

Here is the code in the userform....

Option Explicit

Private Sub UserForm_Initialize()
    
    Dim olFolder As Outlook.MAPIFolder      '**
    Dim olSubfolder As Outlook.MAPIFolder   '**
    Dim olSFtemp As Outlook.MAPIFolder
    Dim blnCreated As Boolean
    
    'Get the Outlook object, create if we need to
    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    If olApp Is Nothing Then
        Set olApp = CreateObject("Outlook.Application")
        blnCreated = True
        Err.Clear
    Else
        blnCreated = False
    End If
    On Error GoTo 0

    'Loop through all folders and get all calendar names (including default)
    Set olFolder = olApp.Session.GetDefaultFolder(olFolderCalendar)
    Me.cbCals.AddItem olFolder.Name
    On Error Resume Next
    For Each olSFtemp In olFolder.Folders
        Me.cbCals.AddItem olSFtemp.Name
    Next olSFtemp
    
End Sub

Private Sub cmbCancel_Click()
    Unload Me
    If Not olApp Is Nothing Then olApp.Quit
End Sub

Private Sub cmbOK_Click()
    If Me.cbCals.Value = "" Then Exit Sub
    Call ExportAppointmentsToOutlook(Me.cbCals.Value)
    MsgBox "All moved!", vbOKOnly, "COMPLETE!"
    Unload Me
End Sub

As you can see I renamed the controls. I added a command button and named it cmbClose. I named your "Okay" button to cmbOK, and the combobox is named cbCals.

The standard module can be named anything and is not dependent (to be named) on anything.

I've uploaded a new sample file (yours, updated & renamed). Let me know if it works for you.

[Sporadic]

Thanks again Zack for the help. I regret to inform you that it still does not work . I checked my premissions I can manually enter/remove anything to and from the shared calendar. When I run the userform1 I will not allow me to select the shared calendar just my own. And when I attempt to tell it to write to my calendar then It just gives me the scripted error and does not write. Now I noticed you have outlook 12 will that make a difference? I only have outlook 11 I had to readjust the Outlook references back to 11 to run it. I am beginging to wonder if 11 is not compatible with writing to shared calendars.

[Zack Barresse]

Hmm, you probably already told me you were using 2003, eh? Ugh, sorry. I don't have 2003 and can't test it. It was my understanding that Exchange/Outlook 2003 shared calendars you could do that. You could always try using the GetSharedDefaultFolder method, or by looking at the Namespace.Folders looking through until you see the shared calendar. I can take a look more at this but it's going to be next week before I get more time to.

[Sporadic]

Thank you for all the help Zack. Ill play around with those options to see if I have any better luck. I think I have found a way around it by writing to my calendar and then pulling both calendars up and dragging the imputed dates across to the shared folder. It is a bit more manual but I am sure I can teach them how to do that. I appreicate all the help and effort you have put in.

[Zack Barresse]

Two great sites to checkout for Outlook VBA is slipstick.com and outlookcode.com. I'm afraid there isn't much more I can do for you there. If I had a testing environment I could probably hack my way through it, but I don't know how to do it off the top of my head.

[Sporadic]

Okay thank you again. I appreciate the help you did give me. I will poke around those sites to see if I can figure it out. You have given me a great an amazing head start.