aide sur rdv outlook depuis Excel

Bonjour Jean;
Je ne suis pas spécialiste Outlook et en plus, je ne peux pas tester dans
l'environnement souhaité; mais regarde si tu peux t'inspirer de quelque
chose comme ça (il faut les droits Administrateur):

Sub CreateOtherUserAppointment()
Dim objApp As Outlook.Application
Dim objNS As Outlook.Namespace
Dim objFolder As Outlook.MAPIFolder
Dim objDummy As Outlook.MailItem
Dim objRecip As Outlook.Recipient
Dim objAppt As Outlook.AppointmentItem
Dim strMsg As String, strName As String
On Error Resume Next
' Nom de la personne dont le calendrier doit être utilisé
strName = "Durand"
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, olFolderCalendar)
If Not objFolder Is Nothing Then
Set objAppt = objFolder.Items.Add
If Not objAppt Is Nothing Then
With objAppt
.Subject = "Test Appointment"
.Start = Date + 14
.AllDayEvent = True
.Save
End With
End If
End If
Else
MsgBox "Could not find " & strName & " !", 64, "User not found"
End If
Set objApp = Nothing: Set objNS = Nothing
Set objFolder = Nothing: Set objDummy = Nothing
Set objRecip = Nothing: Set objAppt = Nothing
End Sub

MP


"Jean" <jj@free.fr> a écrit dans le message de news:
44335932$0$19687$8fcfb975@news.wanadoo.fr...

Bonjour à tous,

J'ai écris le code ci-dessous dans un module vba Excel pour ajouter un rdv
dans Outlook.
Ca marche bien en local.
Le problème c'et que ma macro doit fonctionner sur un disque réseau
partagé
et que ce rendez-vous doit être enregistrer dans le poste de M.Durand
alors
que c'est sur un autre poste que l'on fait tourner l'applis.
Il faudrait pouvoir spécifier le nom de la boite mais je ne sais pas
comment
faire.

Pouvez-vous m'aider ?

Sub AjoutRDV()
Dim AppliOutlook As Outlook.Application
Dim NouveauRDV As Outlook.AppointmentItem

Set AppliOutlook = New Outlook.Application
Set NouveauRDV = AppliOutlook.CreateItem(olAppointmentItem)

With NouveauRDV
.Subject = "Test Nouveau RDV"
.Location = "lieu RDV"
' .Start = #4/4/2006 9:00:00 AM#
.Start = "04/04/2006 09:00:00"
.Duration = 8.5 * 60 ' 510
.ReminderMinutesBeforeStart = 60 * 24
.BusyStatus = olOutOfOffice
.Body = "faut être à l'heure sinon t'es à la bourre"
.Sensitivity = olPrivate
' .Save
.Display
End With

End Sub

Jean