VBA code om Outlook appointment te maken vanuit Access?

[tomswaelen]

Hier zijn we weer met nog maar eens een VBA-vraagje Ik heb een knop nodig die automatisch een Outlook appointment aanmaakt. De tekst en subject (en het uur) van de appointment is altijd dezelfde, alleen moet de datum 30 dagen in de toekomst liggen.

Hoe doe ik dit? Ik heb al eens hulp gekregen met een code om mailtjes te versturen, maar dit zijn dan weer appointments Ik vermoed dat de code er wel gelijkaardig uitziet, maar ik ken dus niets van VBA.

 

[jwaque]

nooit mee gewerkt maar vraag komt regelmatig langs. Misschien kan je wat met dit draadje:
http://www.helpmij.nl/forum/showthr...-outlook-lukt-niet?highlight=outlook+afspraak

http://www.helpmij.nl/forum/showthr...nsturen-vanuit-VBA?highlight=outlook+afspraak

 

[tomswaelen]

Nu heb ik deze code, maar die doet totaal niets...

Private Sub Knop146_Click()

    Dim OutApp As Object
    Dim OutMail As Object
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(1)
    
    
    With OutMail
    .Subject = "Test"
    .Importance = True
    .Start = "9:00 AM"
    .End = "9:05 AM"
    .Body = "Test"
    .Reminderset = True
    '.ReminderTime = 15
    '.display
    .Saved = True
    '.Submitted = True

End Sub

 

[jwaque]

Nu heb ik deze code, maar die doet totaal niets...

Private Sub Knop146_Click()

    Dim OutApp As Object
    Dim OutMail As Object
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(1)
    
    
    With OutMail     [COLOR="#00FFFF"] je begint hier met with dat betekend dat je moet sluiten met end with[/COLOR]
    .Subject = "Test"
  [COLOR="#FF0000"]'[/COLOR]  .Importance = True   [COLOR="#00FFFF"]hier loopt hij bij mij vast. Als ik ipv true low type werkt het wel. of weglaten en normale prioriteit aan je mailtje geven.[/COLOR]    .Start = "9:00 AM"  
    .End = "9:05 AM"  [COLOR="#00FFFF"]waarschijnlijk moet hier nog een datum bij Start = "9:00 AM" & "1-12-2015"[/COLOR]
    .Body = "Test"
    .Reminderset = True
    '.ReminderTime = 15
    '.display                            [COLOR="#00FFFF"]display werkt maar save niet.[/COLOR]
    .Saved = True
    '.Submitted = True
[COLOR="#FF0000"]end with[/COLOR]
End Sub

ik krijg nu wel een mooie afspraak in beeld. maar als ik hem wil bewaren krijg ik ook een foutmelding: eigenschap is alleen lezen.

Hopelijk weet een ander daarvoor een oplossing.

 

[jwaque]

probeer .save

 

[tomswaelen]

Ik heb het gevonden. Deze code werkt:

Private Sub cmdAfspraak_Click()
    Dim olProg As Object
    Dim olAfsp As Object
    Dim blnStart As Boolean
    
    ' Verwijzing naar Outlook
    On Error Resume Next
    Set olProg = GetObject(Class:="Outlook.Application")
    If olProg Is Nothing Then
        Set olProg = CreateObject(Class:="Outlook.Application")
        blnStart = True
    End If
    On Error GoTo ErrHandler
    
    ' Maak een nieuwe afspraak
    Set olAfsp = olProg.CreateItem(1) ' olAppointmentItem
    With olAfsp
        ' Onderwerp
        .Subject = "Onderwerp van de afspraak"
        ' Tekst
        .Body = "Tekst van de afspraak"
        ' Afspraak is over 30 dagen om 9 uur in de morgen
        .Start = Date + 30 + TimeSerial(9, 0, 0)
        ' Afspraak duurt 60 minuten
        .Duration = 60
        ' Stel herinnering in
        .ReminderSet = True
        ' Herinnering 15 minuten tevoren
        .ReminderMinutesBeforeStart = 15
        ' Opslaan
        .Save
    End With
    
ExitHandler:
    On Error Resume Next
    If blnStart Then
        ' Beëindig Outlook als we het hier hadden gestart
        olProg.Quit
    End If
    Exit Sub
    
ErrHandler:
    ' Vertel de gebruiker wat er mis ging
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

 

[jwaque]

Fijn dat het werkt. dank voor het delen van de oplossing