Unable to access a subfolder in Outlook 365 from Excel

[yesid821010]

Hi everybody,

I am trying to create appointments in a Calendar that I call German. I have tried everything no matter what I try:
1. Excel keeps creating the appointment in my default calendar.
2. I can't get it to last 4 minutes even though I have .duration = "00:04:00"

Below is the code, I don't know what I am doing wrong. Thank you in advance.



Sub CreateAppointment()

Dim oApp As Outlook.Application
Dim oNameSpace As Namespace
Dim oItem As AppointmentItem

On Error Resume Next
' check if Outlook is running
Set oApp = GetObject("Outlook.Application")
If Err <> 0 Then
'if not running, start it
Set oApp = CreateObject("Outlook.Application")
End If


Set oNameSpace = oApp.GetNamespace("MAPI").Session.GetDefaultFolder(olFolderCalendar).Folders("German")

lafile = 2

For combiendefois = 0 To lafile
Set oItem = oApp.CreateItem(olAppointmentItem)
With oItem

.Subject = Range("c" & lafile).Value
.Start = Range("a" & lafile).Value
.Duration = "00:04:00"
.Importance = olImportanceNormal
.ReminderSet = True
.ReminderMinutesBeforeStart = "0"
.ReminderPlaySound = False
.Save
End With
lafile = lafile + 1

Next
Set oApp = Nothing
Set oNameSpace = Nothing
Set oItem = Nothing

End Sub

 

[John_w]

Please use CODE tags.

It depends where in the Outlook account(s) the "German" calendar folder occurs, so the following code includes 2 possible options (the Set folder = folder... lines). Duration is a time in minutes, not an Excel time value.

Sub CreateAppointment()

    Dim oApp As Outlook.Application
    Dim oNameSpace As Namespace
    Dim folder As MAPIFolder
    Dim oItem As AppointmentItem
    
    On Error Resume Next
    ' check if Outlook is running
    Set oApp = GetObject("Outlook.Application")
    If Err <> 0 Then
        'if not running, start it
        Set oApp = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0
    
    Set oNameSpace = oApp.GetNamespace("MAPI")
    
    Set folder = oNameSpace.GetDefaultFolder(olFolderCalendar)
    Set folder = folder.Parent.Folders("German")            'Try this line or the next line
    'Set folder = folder.Parent.Parent.Folders("German")

    Dim lafile, combiendefois
    
    lafile = 2
    For combiendefois = 0 To lafile
        Set oItem = folder.Items.Add(olAppointmentItem)
        With oItem
            .Subject = Range("c" & lafile).Value
            .Start = Range("a" & lafile).Value
            .Duration = 4
            .Importance = olImportanceNormal
            .ReminderSet = True
            .ReminderMinutesBeforeStart = 0
            .ReminderPlaySound = False
            .Save
        End With
        lafile = lafile + 1
    Next
    
    Set oApp = Nothing
    Set oNameSpace = Nothing
    Set oItem = Nothing

End Sub

 

[yesid821010]

Hi John,

Thanks it worked great. I had to edit it a bit

I will use the code tags next time.

the first line that you sent was giving me an error message

Set folder = folder.Parent.Folders("German")

so I changed it to

Set folder = folder.Folders("German")

so now it is working.

Since you are knowledgeable in Outlook and Macros, I don't understand how .parent "command" or "object" works, could you give me a clue on how to use it.

Thanks anyway for your help and have a good Sunday.

 

[John_w]

Outlook is a hierarchy of folders, with parent folders and child folders. Each child folder has a parent MAPIFolder (or Namespace or Application) accessed via the Parent property.

I don't know what you mean by "object" in this context.

 

[yesid821010]

No I got it not 100% cause I don't code in outlook all the time but I got the bigger picture. don't know if I'll ever use it. Thank you.