Afspraak in andere Outlook agenda

[8Leonie8]

Hoi allemaal,

Ik heb een database waarin afspraken bijgehouden worden. Nu heb ik via dit forum onderstaande code kunnen achterhalen waarmee ik in mijn invulformulier op een knop kan drukken waardoor de betreffende afspraak meteen wordt aangemaakt in mijn outlook agenda. Werkt allemaal super, maar...

De afspraak moet eigenlijk niet in mijn agenda, maar in de agenda van de desbetreffende adviseur komen te staan. Ik kan vanuit Outlook in hun agenda's komen doordat zij mij gemachtigd hebben, maar is het ook mogelijk om de afspraak vanuit Access direct in de juist agenda te zetten??

Bij deze de huidige code:

Private Sub Knop140_Click()

' Start Outlook.
 ' If it is already running, you'll use the same instance...
   Dim olApp As Outlook.Application
   Set olApp = CreateObject("Outlook.Application")
      
 ' Logon. Doesn't hurt if you are already running and logged on...
   Dim olNs As Outlook.NameSpace
   Set olNs = olApp.GetNamespace("MAPI")
   olNs.Logon

 ' Create a new appointment.
       
   Dim olAppt As Outlook.AppointmentItem
   Set olAppt = olApp.CreateItem(olAppointmentItem)
      
 ' Setup appointment ...
   With olAppt
      .Start = [datum bezoek] + [tijd afspraak]
      .Duration = 60
      .Subject = [adres]
      .Location = [plaats]
      .ReminderSet = False
   End With
      
 ' Save Appointment...
   olAppt.Save
   
     
 ' Clean up...
   MsgBox "De afspraak is aangemaakt in de agenda.", vbMsgBoxSetForeground
   olNs.Logoff
   Set olNs = Nothing
   Set olAppt = Nothing
   Set olItem = Nothing
   Set olApp = Nothing

End Sub

Hoop dat iemand een uitkomst heeft!

Groetjes Leonie

 

[OctaFish]

Je kan eens kijken op deze link. of hier:

Ik weet niet of dit werkt, maar proberen kun het het natuurlijk altijd...

 

[8Leonie8]

Bedankt voor je reactie. Op de site waar jij naar verwijst moet je je inschrijven en ook meteen je creditcard gegevens doorgeven. Dit vind ik nooit zo'n veilig idee. Kun je de oplossing ook op een andere manier communiceren?

b.v.d!

 

[8Leonie8]

Ik heb nu een code gevonden waarmee ik de afspraak in de agenda van een ander kan zetten:

Dim strMsg As String
Dim strName As String
On Error Resume Next

' ### name of person whose Calendar you want to use ###
strName = "naam@xxx.nl"

Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objDummy = objApp.CreateItem(olMailItem)
Set objRecip = objDummy.Recipients.Add(strName)
objRecip.Resolve
If objRecip.Resolved Then
On Error Resume Next
Set objFolder = objNS.GetSharedDefaultFolder(objRecip, 9)
If Not objFolder Is Nothing Then
Set objAppt = objFolder.Items.Add
If Not objAppt Is Nothing Then
With objAppt
.Subject = "Test Appointment"
.start = #6/30/2009 3:00:00 PM# 'MM/JJ/AAAA
.duration = 120
.Save
End With
End If
End If
Else
MsgBox "Could not find " & Chr(34) & strName & Chr(34), , _
"User not found"
End If

Set objApp = Nothing
Set objNS = Nothing
Set objFolder = Nothing
Set objDummy = Nothing
Set objRecip = Nothing
Set objAppt = Nothing

Wie kan mij nog helpen met het laatste stukje waar ik niet uitkom:

In deze code wordt er rechtstreeks naar een agenda verwezen, maar bij mij is de agenda waar de afspraak in moet komen variabel. Als ik in het veld 'adviseur' de code van een adviseur invul, moet de afspraak in de betreffende agenda komen. Hoe kan ik dit in de code aanpassen?

gr leonie

 

[8Leonie8]

Na nog wat zoeken heb ik de oplossing gevonden, dus voor de geinteresseerden:

Private Sub Knop140_Click()

Dim strMsg As String
Dim strName As String

Select Case Me![keuzeveld]
            Case "xx1"
            strName = "naam1@mailadres.nl"
            Case "xx2"
            strName = "naam2@mailadres.nl"
            End Select


' Start Outlook.
' If it is already running, you'll use the same instance...
Set objApp = CreateObject("Outlook.Application")

' Logon. Doesn't hurt if you are already running and logged on...
Set objNs = objApp.GetNamespace("MAPI")

' Create a new appointment.

Set objDummy = objApp.CreateItem(olAppointmentItem)
Set objRecip = objDummy.Recipients.Add(strName)
objRecip.Resolve
If objRecip.Resolved Then
On Error Resume Next
Set objFolder = objNs.GetSharedDefaultFolder(objRecip, 9)
If Not objFolder Is Nothing Then
Set objAppt = objFolder.Items.Add
If Not objAppt Is Nothing Then
With objAppt
.Start = [datum bezoek] + [tijd afspraak]
.Duration = 60
.Subject = [adres]
.Location = [plaats]
.ReminderSet = False
End With
End If
End If
Else
MsgBox "Could not find " & Chr(34) & strName & Chr(34), , _
"User not found"
End If

' Save Appointment...
objAppt.Save


' Clean up...
MsgBox "De afspraak is aangemaakt in de agenda.", vbMsgBoxSetForeground
objNs.Logoff
Set objNs = Nothing
Set objAppt = Nothing
Set objDummy = Nothing
Set objApp = Nothing
Set objFolder = Nothing
Set objRecip = Nothing

End Sub