Vergaderverzoek versturen dmv VBA

[loggy]

Hallo,

Ik probeer een vergaderverzoek te versturen vanuit VBA. Hij doet alles, behalve werkelijk een uitnodiging versturen.
- Sluit ik af met .send, dan heeft hij de afspraak niet opgeslagen en ook niet verstuurd.
- Wanneer ik afsluit met .save ipv .send dan heeft hij keurig een afspraak voor me gemaakt en als ik dan in de afspraak kijk zie ik geen uitnodigingen staan tenzij ik op deelnemers uitnodigen klik. Dan staan ze er wel in, maar staat er bij dat ze niet verzonden zijn. (logisch, ik heb geen .send gekozen, maar ook bij .save & .send doet hij dit niet)
-Sluit ik af met .display, krijg ik ook keurig de afspraak te zien en zie ik wederom de uitgenodigden weer als ik op "deelnemers uitnodigen" klik, maar zijn ze niet verzonden, pas dan veranderd de knop opslaan in verzenden en als ik dan op send klik verstuurd hij ze ook. Omdat dit straks een grote verzamellijst wordt die afspraken gaat plannen is dit niet gewenst.

Wie weet waar het fout gaat? Ik gebruik Office 2010 en dit is de code die ik gebruik:

Sub SetAppt()

Dim olApt As Object ' Outlook.AppointmentItem
Dim olapp As Object ' Outlook.Application
Dim myRequiredAttendee As Object

Dim i As Long
Dim apptRange As Variant
Dim strInfo As String
Dim strtitle As String
Dim intstijl As Integer
Dim intreply As Integer

strInfo = "Weet u zeker dat u deze afspraken in uw agenda wil zetten?"
strtitle = "Agenda vullen"
intstijl = vbOKCancel + vbDefaultButton2
intreply = MsgBox(strInfo, intstijl, strtitle)

[INDENT]If intreply = vbOK Then

Const olAppointmentItem As Long = 1

' create outlook
Set olapp = GetOutlookApp

[INDENT]If olapp Is Nothing Then
MsgBox "Kan Outlook niet Starten"
Exit Sub
End If[/INDENT]
' read appts into array
apptRange = Range(Cells(2, 1), Cells(Rows.Count, 7).End(xlUp)).Value

For i = LBound(apptRange) To UBound(apptRange)
Set olApt = olapp.CreateItem(olAppointmentItem)
[INDENT]With olApt
.MeetingStatus = olMeeting
.Start = apptRange(i, 6)
[INDENT]If InStr(apptRange(i, 7), "Hour") > 0 Then
' numeric portion cell is delimited by space
.Duration = 60 * Split(apptRange(i, 7), " ")(0)
Else
.Duration = apptRange(i, 7)
End If[/INDENT].Subject = apptRange(i, 1)
.Location = apptRange(i, 3)
.Body = apptRange(i, 2)
.ReminderSet = apptRange(i, 4)
.ReminderMinutesBeforeStart = apptRange(i, 5)
.Importance = 2
End With[/INDENT]Set myRequiredAttendee = olApt.Recipients.Add("rboer@harsco.com")
myRequiredAttendee.Type = olRequired
Set myResourceAttendee = olApt.Recipients.Add("testlocatie")
myResourceAttendee.Type = olResource
olApt.Send
'olApt.Display
'olApt.Save

Next i

MsgBox "Er zijn " & i - 1 & " afspraken toegevoegd aan uw agenda."

Set olApt = Nothing

End If[/INDENT]
End Sub

 

[OctaFish]

Begin eerst eens met de code netjes op te maken met de CODE knop. Dit is onleesbaar. Uiteraard netjes in laten springen, zodat we de structuur ook zien.

 

[wampier]

1) zet je code even tussen code tags, dat maakt het een stuk makkelijker voor mensen
2) heeft het "default" account wel zendrechten en een correcte instelling?
3) heb je probeert om eerst .display en dan .send te doen?

 

[snb]

Hij stond al voor je klaar:

http://www.snb-vba.eu/VBA_Outlook_external.html#L212

 

[OctaFish]

Haal dan de code hierboven weg, want dit is nu natuurlijk dubbelop. Het ging er juist om dat bovenstaande code uit bericht #1 netjes werd opgemaakt...

 

[loggy]

@ OctaFish AdYourService.
@ Wampier: punt 1: gedaan,
punt 2: Ja,
punt 3: Ook geprobeert werkte niet

@ SNB: Dat voorbeeld werkt fantanstisch, ps complimenten voor de site, erg verhelderend. Ik ga deze code verwerken in mijn eigen code en hou jullie dan weer op de hoogte.

 

[loggy]

Heren het is gelukt dankzij SNB. Thankx. De code is als volgt geworden:

Sub vergaderverzoek()

    Dim strInfo As String
    Dim apptRange As Variant
    Dim strtitle As String
    Dim intstijl As Integer
    Dim intreply As Integer

    strInfo = "Weet u zeker dat u deze afspraken in uw agenda wil zetten?"
    strtitle = "Agenda vullen"
    intstijl = vbOKCancel + vbDefaultButton2
    intreply = MsgBox(strInfo, intstijl, strtitle)
          
        If intreply = vbOK Then
        
        apptRange = Range(Cells(2, 1), Cells(Rows.Count, 8).End(xlUp)).Value
        
            For i = LBound(apptRange) To UBound(apptRange)
            
                With CreateObject("Outlook.Application").CreateItem(1)
                .Subject = apptRange(i, 1)
                .MeetingStatus = 1
                .Location = apptRange(i, 3)
                .Start = apptRange(i, 6)
                    If InStr(apptRange(i, 7), "Hour") > 0 Then
                    .Duration = 60 * Split(apptRange(i, 7), " ")(0)
                    Else
                    .Duration = apptRange(i, 7)
                    End If
                .Recipients.Add apptRange(i, 8)
                .send
                End With

            Next i
            
        MsgBox "Er zijn " & i - 1 & " afspraken toegevoegd aan uw agenda."
        
        End If
        
End Sub

 

[snb]

Zo zie ik dat graag !
Hoeveel simpeler.
(nu nog wel even die declaraties verwijderen.... )

 

[loggy]

@ SNB, we blijven dimmen. Anders krijg ik ruzie met mn leraar van mn cursus van 2 wkn terug.

 

[snb]

Mij ontgaat toch echt de zin van :

    Dim strInfo As String
    Dim strtitle As String
    Dim intstijl As Integer
    Dim intreply As Integer

    strInfo = "Weet u zeker dat u deze afspraken in uw agenda wil zetten?"
    strtitle = "Agenda vullen"
    intstijl = vbOKCancel + vbDefaultButton2
    intreply = MsgBox(strInfo, intstijl, strtitle)
    If intreply = vbOK Then

ten opzichte van

   if MsgBox( "Weet u zeker dat u deze afspraken in uw agenda wil zetten?", vbOKCancel + vbDefaultButton2,"Agenda vullen")=vbOK Then

Het gebruik van een niet-variërende variabele lijkt mij een contradictio in terminis.