• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Afspraak in gedeelde agenda + afspraken verwijderen

Status
Niet open voor verdere reacties.
T

tshw3

Gebruiker
Lid geworden
19 mei 2017
Berichten
92
Beste forumleden,

Naar aanleiding van onderstaand forum aan het puzzelen gegaan:
https://www.helpmij.nl/forum/showthread.php/964221-vanuit-excel-een-afspraak-in-outlook-agenda-toevoegen

Ik heb namelijk het excel virus weer te pakken (grote beginneling) en wil graag wat zaken vergemakkelen. Korte situatie schets: Op het werk voeren wij updates uit, dit zijn meerdere op een avond/week en in een maand, deze worden gepland in één systeem waarbij de volgende gegevens ontstaan; datum, tijd, klant, duur van afspraak. Zo'n update wordt uitgevoerd door verschillende collega's waarbij ik bij alle agenda's volledige bewerkrechten heb.

Wat zou ik graag willen kunnen:
- Afspraken plaatsen in een specifieke agenda (op basis van mail adres die ik dan zal vullen in een veld in excel, kolom M)
- Van dezelfde aangemaakte lijst alle afspraken verwijderen zodat bij wijzigingen ze opnieuw met de macro in de agenda kan worden gezet
- Of natuurlijk macro checkt gewijzigde afspraken -> verwijdert huidige -> voegt nieuwe toe echter dit lijkt me te lastig (want wat was de oude dan).


Ik verwacht niet dat het even wordt gemaakt en dan werkt het, wil het ook gaan begrijpen.

Wat heb ik al gedaan:

Ik wil absoluut niet met de credits ervandoor gaan, dus mede door input snb/friend/jec/hsv zaken aangepast.
Met name de volgorgde van velden en zodat ik naar meerdere personen iets kon sturen, was:
Code: 
Sub Teun()
  sn = Blad1.Cells(1).CurrentRegion
For j = 2 To UBound(sn)

  With CreateObject("Outlook.Application").CreateItem(1)
      .Start = sn(j, 4) + sn(j, 5)
      .Duration = sn(j, 6) - sn(j, 5)
      .Subject = sn(j, 1) & " " & sn(j, 2) & " " & sn(j, 3)
      .Location = sn(j, 9)
      .Body = sn(j, 8)
      .AllDayEvent = sn(j, 10) = "j"
      .ReminderSet = sn(j, 11) = "j"
      .ReminderMinutesBeforeStart = sn(j, 12)
      .Save
      
  End With
  Next
     MsgBox "Afsraken zijn toegevoegd aan de kalender :-)"
End Sub

Alleen na wat extra feedback is onderstaand eruit komen rollen.
Code: 
Sub Teun()
  sn = Blad1.Cells(1).CurrentRegion


 With CreateObject("Outlook.Application")
    For j = 2 To UBound(sn)
      With .createitem(1)
      .Start = sn(j, 4) + sn(j, 5)
      .Duration = sn(j, 6) - sn(j, 5)
      .Subject = sn(j, 1) & " " & sn(j, 2) & " " & sn(j, 3)
      .Location = sn(j, 9)
      .Body = sn(j, 8)
      .AllDayEvent = sn(j, 10) = "j"
      .ReminderSet = sn(j, 11) = "j"
      .ReminderMinutesBeforeStart = sn(j, 12)
      .Save
    End With
  Next
     MsgBox "Afsraken zijn toegevoegd aan de kalender :-)"
End With
End Sub

Het stuk om afspraken te kunnen verwijderen en agenda afspraken toe te voegen, dit forum van snb is vrij duidelijk maar kom er niet helemaal uit:
https://www.snb-vba.eu/VBA_Outlook_external.html#L_10.1

Verwijderen van agenda afspraken - EDIT; Opgelost door HSV, dankje
Vanuit het voorbeeld op de website, heb ik het volgende van gemaakt:
Code: 
Sub Afspraak_Verwijderen()
    sn = Blad1.Cells(1).CurrentRegion
    c00 = sn(j, 7)
    For j = 2 To UBound(sn)
    .GetNamespace("MAPI").GetDefaultFolder(9).Items(c00).Delete
    Next
    End With
End Sub

Bovenstaand werkt niet, maar als ik het goed intrepeteer:
Regel 1 definieert het bereik
Regel 2 Definieert wat de waarde C00 is, in dit geval hetgeen wat in cel 7 staat (Maar waarom verwijderen op basis van onderwerp?, althans dat is mijn intrepreatie op snb website).
Regel 3 Zodat het blijft doorgaan tot alle regels zijn afgehandeld
Regel 4 het daadwerkelijk verwijderd op basis van de waarde C00, echter als ik de basale formule gebruik op mijn afspraak dan vindt het systeem ook niks (ik gebruik office 365).

Wat begrijp ik bij bovenstaand niet goed?

Het schrijven in een gedeelde agenda in outlook
Punt 2 is het maken van de afspraak in een andere agenda, informatie die te vinden is, is bijvoorbeeld https://stackoverflow.com/questions/37353404/how-to-add-an-appointment-to-a-shared-calendar-in-outlook

Ook hier staat in het Engels een uitleg maar dat gaat verder dan wat ik nodig heb.
Zoals; Create reference/select file path/select workbook is volgensmij overbodig.
Volgensmij geeft Walkdog onderaan het forum het antwoord maar dan moet create email eruit, maar vraag me af waar olApp en olNS vandaan komt.

Het stukje initialize variables begrijp ik niet, wat ga je initialiseren?
Code: 
Dim iRow As Integer
Dim iCol As Integer
Dim oNs As Namespace
Dim olFldr As Outlook.MAPIFolder
Dim objOwner As Outlook.Recipient

al met al, bovenstaand vind ik voor nu nog erg latig en kan iemand mij op weg helpen?
.snb-vba.eu bevat veel info maar volgensmij deze informatie (nog) niet.

Voorbeelddocument:
Bekijk bijlage Afspraken importeren in outlook agenda.xlsm

Graag wil ik benadrukken, ik snap echt heel goed dat alle antwoorden niet meteen worden gegeven omdat zelfonderzoek belangrijk is. Dus wat sturing is ook welkom.

mvg,
Teun
 
Laatst bewerkt:
Even goed kijken naar c00 wat wat is.
Code: 
Sub Afspraak_Verwijderen()
sn = Blad1.Cells(1).CurrentRegion
 With CreateObject("Outlook.Application").GetNamespace("MAPI").getdefaultFolder(9)
    For j = 2 To UBound(sn)
        c00 = Join(Array(sn(j, 1), sn(j, 2), sn(j, 3)))
       .Items(c00).Delete
    Next
   MsgBox "Afsraken zijn verwijderd :-)"
 End With
End Sub
 
HSV zei:
Even goed kijken naar c00 wat wat is.
Code: 
Sub Afspraak_Verwijderen()
sn = Blad1.Cells(1).CurrentRegion
 With CreateObject("Outlook.Application").GetNamespace("MAPI").getdefaultFolder(9)
    For j = 2 To UBound(sn)
        c00 = Join(Array(sn(j, 1), sn(j, 2), sn(j, 3)))
       .Items(c00).Delete
    Next
   MsgBox "Afsraken zijn verwijderd :-)"
 End With
End Sub
Klik om te vergroten...

Goedenavond Harry,

Dank voor de snelle reactie en het werkt inderdaad.

Voor de c00 was dus inderdaad een verkeerde intrepertatie, het verwijderen gaat d.m.v. titel afspraak en omdat ik 3 velden gebruik voeg je ze samen met Join Array.
Createobject had ik eruit gehaald (achteraf stom) omdat ik dacht, je wilt niet iets 'aanmaken' maar dat doe je schijnbaar ook niet...

Op zijn grunnegs dainj!
 
Laatst bewerkt:
HSV zei:
Even goed kijken naar c00 wat wat is.
Klik om te vergroten...

Ik probeer nu ook de optie afspraak wijzigen toe te voegen, dus dat het niet verwijderd maar kan wijzigen op basis van sn j1/2/3
Dan kom ik op het volgende uit:
Code: 
Sub Afspraak_Wijzigen()
sn = Blad1.Cells(1).CurrentRegion
c00 = Join(Array(sn(j, 1), sn(j, 2), sn(j, 3)))

 With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(9).Items(c00)
        For j = 2 To UBound(sn)
            .Start = sn(j, 4) + sn(j, 5)
            .Duration = sn(j, 6) - sn(j, 5)
            .Save
    End With
    Next
        MsgBox "Afspraken zijn gewijzigd"
End Sub

Vergeleken met (van SNB website):
Code: 
Sub afspraak_wijzigen()
c00 = "Jaarvergadering"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(9).Items(c00)
.start = DateAdd("d", 4, .start) + DateAdd( "h", 2, .start)
.Save
End With
End Sub

Wat ik zie is dat jij de C00 definieert in de with, maar met wijzigen kan dit niet want je zoekt op items(C00) echter wil ik niet DateAdd doen maar letterlijk een nieuwe datum + tijd overnemen van de waarde in excel. Dus die ik ook bij het aanmaken van de afspraak heb gebruikt:
Code: 
.Start = sn(j, 4) + sn(j, 5)
.Duration = sn(j, 6) - sn(j, 5)

Totale formule:
Code: 
Sub Teun()
  sn = Blad1.Cells(1).CurrentRegion
For j = 2 To UBound(sn)

  With CreateObject("Outlook.Application").createitem(1)
      .Start = sn(j, 4) + sn(j, 5)
      .Duration = sn(j, 6) - sn(j, 5)
      .Subject = sn(j, 1) & " " & sn(j, 2) & " " & sn(j, 3)
      .Location = sn(j, 9)
      .Body = sn(j, 8)
      .AllDayEvent = sn(j, 10) = "j"
      .ReminderSet = sn(j, 11) = "j"
      .ReminderMinutesBeforeStart = sn(j, 12)
      .Save
      
  End With
  Next
     MsgBox "Afspraken zijn toegevoegd aan de kalender"
End Sub

Wat doe ik verkeerd? Het schrijven in een gedeelde agenda is ook nog een behoorlijke klus, ik lijk daar niet echt verder in te komen.
 
Laatst bewerkt:
Ik definieer C00 inderdaad op de Join net zoals in het voorbeeld van @snb C00 = "jaarvergadering"

Als je het niet wilt aanpassen moet je het eerst verwijderen.
Wil je het aanpassen, maar je weet niet of C00 bestaat?
Code: 
On Error Resume Next
  s0 = .items(c00).Location <> ""
If Err.Number = 0 Then  pas het aan


De lokale (standaard) order is niet toegankelijk voor gedeelde agenda.

Oplossing in de link hieronder.
https://docs.microsoft.com/de-de/office/vba/api/outlook.namespace.getshareddefaultfolder
 
HSV zei:
Als je het niet wilt aanpassen moet je het eerst verwijderen.
Wil je het aanpassen, maar je weet niet of C00 bestaat?
Klik om te vergroten...

Wellicht heb ik mijzelf niet goed duidelijk gemaakt of ik begrijp het niet.
Het stukje code die je toestuurt, daar moet ik uitkomen.

Ik moet er nog even mee stoeien (helaas pas morgen) maar dan krijg je zoiets:

Code: 
Sub Afspraak_Wijzigen()
sn = Blad1.Cells(1).CurrentRegion
c00 = Join(Array(sn(j, 1), sn(j, 2), sn(j, 3)))

On Error Resume Next
  s0 = .items(c00).Location <> ""
If Err.Number = 0 Then  pas het aan

 With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(9).Items(c00)
        For j = 2 To UBound(sn)
            .Start = sn(j, 4) + sn(j, 5)
            .Duration = sn(j, 6) - sn(j, 5)
            .Save
    End With
    Next
        MsgBox "Afspraken zijn gewijzigd"
End Sub

Maar het volgende moet toch mogelijk zijn?
- Je hebt afspraken in de agenda gemaakt door de formule sub Teun in post 4
- Vervolgens zoek je de afspraak op in je agenda
- Als gevonden -> ga door, niet gevonden, stop
- Als gevonden pas de datum + tijd aan

De formule die ik nu heb, die werkt niet:
Code: 
Sub Afspraak_Wijzigen()
sn = Blad1.Cells(1).CurrentRegion
c00 = Join(Array(sn(j, 1), sn(j, 2), sn(j, 3)))

 With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(9).Items(c00)
        For j = 2 To UBound(sn)
            .Start = sn(j, 4) + sn(j, 5)
            .Duration = sn(j, 6) - sn(j, 5)
            .Save
    End With
    Next
        MsgBox "Afspraken zijn gewijzigd"
End Sub

Voor de zekerheid nog een voorbeeldbestand:
Bekijk bijlage Afspraken importeren in outlook agenda v2.xlsm
 
Wat je wil is filteren en wijzigen.
Een uitgewerkt voorbeeld op de website.

Code: 
Sub afspraken_filteren_wijzigen()    
   c01=[COLOR=green]"Sessie B"[/COLOR]
   c02=[COLOR=green]"Room 203"[/COLOR]
   c00 = "[Location]='" & c01 & "'"

    For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(9).Items.Restrict(c00)
      it.Location = c02
     it.start = DateAdd( [COLOR=green]"d"[/COLOR], [COLOR=green]1[/COLOR], it.start)
     it.Save

   Next

 End Sub
 
Laatst bewerkt:
snb zei:
Wat je wil is filteren en wijzigen.
Een uitgewerkt voorbeeld op de website.

Code: 
Sub afspraken_filteren_wijzigen()    
   c01=[COLOR=green]"Sessie B"[/COLOR]
   c02=[COLOR=green]"Room 203"[/COLOR]
   c00 = "[Location]='" & c01 & "'"

    For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(9).Items.Restrict(c00)
      it.Location = c02
     it.start = DateAdd( [COLOR=green]"d"[/COLOR], [COLOR=green]1[/COLOR], it.start)
     it.Save

   Next

 End Sub
Klik om te vergroten...

Goedemorgen allen,

Dit weekend weer zitten stoeien maar het is alles behalve makkelijk, dit komt met name door de shared calender waardoor het continu anders werkt dan in mijn eigen agenda.
Het toevoegen is inmiddels gelukt met:
Code: 
Sub Make_Appointments_in_Shared_Calander()
    
    Dim answer As Integer
    answer = MsgBox("Wil je deze afspraken toevoegen aan de gedeelde agenda's?", vbQuestion + vbYesNo + vbDefaultButton2, "Message Box Title")
    If answer = vbYes Then
    
    Dim outNameSpace As Object
    Dim outSharedName As Object
    Dim outCalendarFolder As Object
    Dim outAppointment As Object
    Dim outApp As Outlook.Application
    
    Set outApp = Outlook.Application
    
    Dim SharedMailboxEmail As String
    
    
    sn = Blad1.Cells(1).CurrentRegion
    For j = 2 To UBound(sn)
    
    
    SharedMailboxEmail = sn(j, 13)
    Set outNameSpace = outApp.GetNamespace("MAPI")
    Set outSharedName = outNameSpace.CreateRecipient(SharedMailboxEmail)
    Set outCalendarFolder = outNameSpace.GetSharedDefaultFolder(outSharedName, 9) '9=olFolderCalendar
    Set outAppointment = outCalendarFolder.Items.add(1) '1=olAppointmentItem
    
    With outAppointment
      .Start = sn(j, 4) + sn(j, 5)
      .Duration = sn(j, 6) - sn(j, 5)
      .Subject = sn(j, 1) & " " & sn(j, 2) & " " & sn(j, 3)
      .Location = sn(j, 9)
      .Body = sn(j, 8)
      .AllDayEvent = sn(j, 10) = "j"
      .ReminderSet = sn(j, 11) = "j"
      .ReminderMinutesBeforeStart = sn(j, 12)
      .Save
    End With
    
    
    Next
     MsgBox "Afspraken zijn toegevoegd aan de shred kalender"

Else
End If
End Sub

Alleen het wijgigen van de afspraak blijft maar fout gaan, deze code werkt voor mijn default agenda maar voor een shared agenda wordt de afspraak wel verplaatst maar de oude blijft ook staan. Wie ziet wat er fout gaat?
Code: 
Sub Change_Appointments_in_Shared_Calander()

    Dim answer As Integer
    
    answer = MsgBox("Wil je alle afspraken updaten met Ja?!", vbQuestion + vbYesNo + vbDefaultButton2, "Message Box Title")
    If answer = vbYes Then

    Dim outNameSpace As Object
    Dim outSharedName As Object
    Dim outCalendarFolder As Object
    Dim outAppointment As Object
    Dim outApp As Outlook.Application
    Set outApp = Outlook.Application
    Dim SharedMailboxEmail As String
    Dim oitem
    
    Dim oOL As New Outlook.Application
    Dim oNS As Outlook.Namespace
    Dim oAppointments As Object
    Dim oAppointmentItem As Outlook.AppointmentItem
    Dim iReply As VbMsgBoxResult
    
    sn = Blad1.Cells(1).CurrentRegion
    Set oNS = oOL.GetNamespace("MAPI")
    Set oAppointments = oNS.GetDefaultFolder(olFolderCalendar)

Count = oAppointments.Items.Coun
If Count = 0 Then
iReply = MsgBox("Geen afspraken gevonden, wil je deze aanmaken?", vbYesNo)
    If iReply = vbYes Then
GoTo addappointments
    Else
GoTo lastend
End If
End If

    sn = Blad1.Cells(1).CurrentRegion
    
    Range("N10000").End(xlUp).Select
    num = ActiveCell.Row
    
    For Each c In Range("N2:N" & num)
    
    If c <> "" Then
    c.Select
    rnum = ActiveCell.Row
    apname = sn(rnum, 1) & " " & sn(rnum, 2) & " " & sn(rnum, 3)
        For Each oAppointmentItem In oAppointments.Items
        opname = oAppointmentItem.Subject
        If apname = opname Then
        oAppointmentItem.Delete
        Else
        
        End If
        Next
        
    End If
    Next
    
addappointments:

    Range("N10000").End(xlUp).Select
    num = ActiveCell.Row
    
    For Each c In Range("N2:N" & num)
    If c <> "" Then
    c.Select
    
        SharedMailboxEmail = sn(ActiveCell.Row, 13)
    Set outNameSpace = outApp.GetNamespace("MAPI")
    Set outSharedName = outNameSpace.CreateRecipient(SharedMailboxEmail)
    Set outCalendarFolder = outNameSpace.GetSharedDefaultFolder(outSharedName, 9)
    Set outAppointment = outCalendarFolder.Items.add(1)
  
    With outAppointment
      .Start = sn(ActiveCell.Row, 4) + sn(ActiveCell.Row, 5)
      .Duration = sn(ActiveCell.Row, 6) - sn(ActiveCell.Row, 5)
      .Subject = sn(ActiveCell.Row, 1) & " " & sn(ActiveCell.Row, 2) & " " & sn(ActiveCell.Row, 3)
      .Location = sn(ActiveCell.Row, 9)
      .Body = sn(ActiveCell.Row, 8)
      .AllDayEvent = sn(ActiveCell.Row, 10) = "j"
      .ReminderSet = sn(ActiveCell.Row, 11) = "j"
      .ReminderMinutesBeforeStart = sn(ActiveCell.Row, 12)
      .Save
    End With
    
End If
Next

MsgBox ("Afspraken met JA succesvol bijgewerkt")
 
Else
  End If
lastend:

End Sub

Enige wat is veranderd, is dat er een kolom N is toegevoegd met Yes erin als de rij moet updaten. Maar het lijkt me niet dat dit de afspraken moet dupliceren... Wie heeft het antwoord voor me?
 
Kun je testen of deze ook werkt ?
Dan kan ik je vervolgens met het vervolg helpen.

Code: 
Sub M_snb()
  sn = Blad1.Cells(1).CurrentRegion
    
  With CreateObject("outlook.application").GetNamespace("MAPI")
    With .GetSharedDefaultFolder(.CreateRecipient(sn(j, 13)), 9).Items
      For j = 2 To UBound(sn)
        With .Add(1)
          .Start = sn(j, 4) + sn(j, 5)
          .Duration = sn(j, 6) - sn(j, 5)
          .Subject = sn(j, 1) & " " & sn(j, 2) & " " & sn(j, 3)
          .Location = sn(j, 9)
          .Body = sn(j, 8)
          .AllDayEvent = sn(j, 10) = "j"
          .ReminderSet = sn(j, 11) = "j"
          .ReminderMinutesBeforeStart = sn(j, 12)
          .Save
        End With
      Next
    End With
  End With
End Sub
 
Laatst bewerkt:
snb zei:
Kun je testen of deze ook werkt ?
Dan kan ik je vervolgens met het vervolg helpen.
Klik om te vergroten...

Goedemorgen snb,

Ik krijg hier een error op:
1.png


2.png


Deze lijkt dus (nog) niet te werken (getest in mijn eigen agenda d.m.v. intypen mail adres in kolom M).

4.png


mvg,
Teun
 
Je ziet toch dat het om de gemeenschappelijke folder gaat (daar gaat jouw code toch ook over :shocked:). Dan moet je hem natuurlijk ook daar testen. Dan moet in kolom M een geldig adres staan van de gemeenschappelijke folder.
 
snb zei:
Je ziet toch dat het om de gemeenschappelijke folder gaat (daar gaat jouw code toch ook over :shocked:). Dan moet je hem natuurlijk ook daar testen. Dan moet in kolom M een geldig adres staan van de gemeenschappelijke folder.
Klik om te vergroten...

Ik vul daar het mail adres in van de gedeelde agenda, als ik het test met een ander mail adres (waar ik volledige rechten heb) dan krijg ik nog steeds, subscript valt buiten het bereik.
Wil je een voorbeeld bestand?
 
Als de door jou geplaatste code werkt, moet deze het ook doen (zonder al die overbodige objectvariabelen).
 
Vooruit dan maar:
Code: 
Sub M_snb()
  sn = Blad1.Cells(1).CurrentRegion
    
  With CreateObject("outlook.application").GetNamespace("MAPI")
    With .GetSharedDefaultFolder(.CreateRecipient(sn(2, 13)), 9).Items
      For j = 2 To UBound(sn)
        With .add(1)
          .Start = sn(j, 4) + sn(j, 5)
          .Duration = sn(j, 6) - sn(j, 5)
          .Subject = sn(j, 1) & " " & sn(j, 2) & " " & sn(j, 3)
          .Location = sn(j, 9)
          .Body = sn(j, 8)
          .AllDayEvent = sn(j, 10) = "j"
          .ReminderSet = sn(j, 11) = "j"
          .ReminderMinutesBeforeStart = sn(j, 12)
          .Save
        End With
      Next
    End With
  End With
End Sub

Probeer jezelf wat debugging vaardigheden aan te leren (met de muis over variabelen gaan, bijvoorbeeld)
 
snb zei:
Probeer jezelf wat debugging vaardigheden aan te leren (met de muis over variabelen gaan, bijvoorbeeld)
Klik om te vergroten...

Daar heb je zeker gelijk in, goede tip. Zitten al aardig wat uren in maar debugging nog niet echt gedaan.
Dit script werkt inderdaad, ik zie ook wat je hebt veranderd. Het verzet de afspraken maar verwijderd (verplaatst) het nog niet.
1.png
 
Je hebt nu in kolom 13 steeds hetzelfde mailadres.
Kan dat ook variëren ? Zijn er met andere woorden verschillende gemeenschappelijke folders ?

Hoezo verwijderen/verplaatsen ? Daar heb ik het toch helemaal niet over gehad ? Lees de draad nog eens rustig van voor naar achter door.
 
Laatst bewerkt:
snb zei:
Je hebt nu in kolom 13 steeds hetzelfde mailadres.
Kan dat ook variëren ? Zijn er met andere woorden verschillende gemeenschappelijke folders ?

Hoezo verwijderen/verplaatsen ? Daar heb ik het toch helemaal niet over gehad ? Lees de draad nog eens rustig van voen naar ahcteren door.
Klik om te vergroten...

Hallo snb,

Er kan inderdaad op iedere regel een ander mail adres (gemeenschappelijke folder) staan.
In post 8 heb ik geprobeerd toe te lichten dat juist het verplaatsen niet lukt.

Voor wat betreft wat ik afgelopen dagen probeer te realiseren:
- Aanmaken van agenda afspraken (deze werkte en werkt ook met jouw code)
- Het wijzigen en verplaatsen van afspraken (deze probeer ik op te lossen afgelopen dagen en dat krijg ik niet voor elkaar, vandaar al die objecten etc.)
- Dus als afspraak in de lijst bestaat op basis van kolom 1/2/3 (titel) en heeft een andere datum(4)/tijd(5) of duur(6) van de afspraak dan moet die het wijzigen en als het nog niet bestaat aanmaken.
- Het verwijderen van afspraken in de lijst (het minst relevant)
 
Laatst bewerkt:
Als de waarde in kolom 13 steeds kan wisselen:

Code: 
Sub M_snb()
  sn = Blad1.Cells(1).CurrentRegion
    
  With CreateObject("outlook.application").GetNamespace("MAPI")
    For j = 2 To UBound(sn)
      With .GetSharedDefaultFolder(.CreateRecipient(sn(j, 13)), 9).Items.add(1)
        .Start = sn(j, 4) + sn(j, 5)
        .Duration = sn(j, 6) - sn(j, 5)
        .Subject = sn(j, 1) & " " & sn(j, 2) & " " & sn(j, 3)
        .Location = sn(j, 9)
        .Body = sn(j, 8)
        .AllDayEvent = sn(j, 10) = "j"
        .ReminderSet = sn(j, 11) = "j"
        .ReminderMinutesBeforeStart = sn(j, 12)
        .Save
      End With
    Next
  End With
End Sub
 
Laatst bewerkt:
snb zei:
Als de waarde in kolom 13 steeds kan wisselen:
Klik om te vergroten...


Getest en werkt inderdaad. Alleen het aanpassen van een afspraak krijg ik niet voor elkaar in een gedeelde agenda, ook niet met de formules op jouw website.
Heb je daar nog advies in?
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan