vanuit excel een afspraak in outlook agenda toevoegen

[snb]

Ik werd er via een PM op geattendeerd dat de code in #13 slechts 1 afspraak maakt.
Dom, dom, dom.

Ik heb de code daar aangepast. https://www.helpmij.nl/forum/showth...da-toevoegen?p=6325451&viewfull=1#post6325451

 

[Friend]

Voor degenen die dit misschien nog volgen.

Met een aanpassing in de code van Snb hem ik hem aan het werk voor zover het één regel betreft. Het loopen werkt nog niet dan wordt de eerste regel weer overschreven in outlook. Hoe dat kan begrijp ik nog niet.

Ik heb de code nu als volgt :

Sub M_snb()
  sn = Blad1.Cells(1).CurrentRegion
    
  With CreateObject("Outlook.Application").CreateItem(1)
    For j = 2 To UBound(sn)
      .Start = sn(j, 3) + sn(j, 5)
      .End = sn(j, 3) + sn(j, 6)
'      .Duration = sn(j, 6) - sn(j, 5)
      .Subject = "Birthday " & sn(j, 2) & " " & sn(j, 1)
      .Location = sn(j, 10)
      .Body = sn(j, 11)
      .MeetingStatus = 0
      .AllDayEvent = sn(j, 13) = "j"
      .ReminderSet = True
      .ReminderMinutesBeforeStart = sn(j, 7)
      .Save
    Next j
  End With
End Sub

End toegevoegd en Duration uitgezet.

Dat bracht mij wel op het idee om in de eerste code een aanpassing te doen en jawel dat werkt ook met meerdere regels.
Hiervoor heb ik nu de volgende code:

Sub ToCalendar()
    'Add reference to MS Outlook Lbrary
    Dim oOL As Outlook.Application, oAppoint As Outlook.AppointmentItem
    Dim oWS As Worksheet, r As Long, i As Long, sStart, sHeleDag As String
    
    Set oWS = Blad1
    r = oWS.Range("A1").CurrentRegion.Rows.Count
    
    Set oOL = New Outlook.Application
    
    For i = 2 To r
        Set oAppoint = oOL.CreateItem(olAppointmentItem)
        With oAppoint
            sStart = oWS.Cells(i, 3)
            sStart = Left(sStart, Len(sStart) - 4) & Year(Date)
            .Start = oWS.Cells(i, 3) + oWS.Cells(i, 5)
            .End = oWS.Cells(i, 3) + oWS.Cells(i, 6)
'            .Duration = oWS.Cells(i, 12)
            .Subject = "Birth Date" & " " & oWS.Cells(i, 2) & " " & oWS.Cells(i, 1)
            .Location = oWS.Cells(i, 10)
            .Body = oWS.Cells(i, 11)
            .MeetingStatus = olNonMeeting
                
                If oWS.Cells(i, 13) = "j" Then
                   .AllDayEvent = True
                Else
                    .AllDayEvent = False
                End If
            
            .ReminderSet = True
            .ReminderMinutesBeforeStart = oWS.Cells(i, 7)
            .Save
        End With
            
   
Next i
MsgBox "Reminder(s) Added To Outlook Calendar"
Set oOL = Nothing
End Sub

aangepast

.Start = oWS.Cells(i, 3) + oWS.Cells(i, 5)

toegevoegd :

.End = oWS.Cells(i, 3) + oWS.Cells(i, 6)

Uitgezet : duration

Allen dank.

Friend

 

[snb]

@Friend

svp alle bijdragen lezen:

https://www.helpmij.nl/forum/showth...da-toevoegen?p=6325451&viewfull=1#post6325451