Hej alla experter där ute,

Jag är ingen expert och ber därför ödmjukast om hjälp att lösa ett litet problem jag har.

Jag har en enkel VBA-kod nedan som skapa outlook händelser i standard kalendern.

Nu skulle jag vilja att makrot gör antingen:

1. Skapar en ny underkalender till standardkalendern i outlook och där namnet till den nya kalendern tas från A1.
eller
2. Bara placerar händelserna i en underkalender som redan finns i outlook, där namnet till denna kalender återfinns i A1.


Alt. 1 är så klart att föredra men jag kan leva med alt 2 också.

Vi använder Outlook för Office365 och makrot ska fungera för alla som använder excel-dokumentet i office 365-miljön.

Blir oerhört glad om någon kan förbarma sig över denna lilla uppgift.
Tusen tack på förhand.



Sub AddAppointments()
Dim i As Long
Dim xRg As Range
Dim xOutApp As Object
Dim xOutItem As Object
Set xOutApp = CreateObject("Outlook.Application")
Set xRg = Range("D3:J58")

For i = 1 To xRg.Rows.Count
Set xOutItem = xOutApp.createitem(1)
Debug.Print xRg.Cells(i, 1).Value
xOutItem.Subject = xRg.Cells(i, 1).Value
xOutItem.Location = xRg.Cells(i, 2).Value
xOutItem.Start = xRg.Cells(i, 3) + TimeValue("9:00:00")
xOutItem.Duration = xRg.Cells(i, 4).Value
If Trim(xRg.Cells(i, 5).Value) = "" Then
xOutItem.BusyStatus = 2
Else
xOutItem.BusyStatus = xRg.Cells(i, 5).Value
End If
If xRg.Cells(i, 6).Value > 0 Then
xOutItem.ReminderSet = True
xOutItem.ReminderMinutesBeforeStart = xRg.Cells(i, 6).Value
Else
xOutItem.ReminderSet = False
End If
xOutItem.Body = xRg.Cells(i, 7).Value
xOutItem.Save
Set xOutItem = Nothing
Next
Set xOutApp = Nothing
End Sub