Pb envoie de message

Bonjour,

J'utilise un code pour créer un message automatique à différent utilisateur.

Mon Probleme vient de notre messagerie (Microsoft outlook 2003) Qui nous
demande si nous donnons l'autorisation t'utilisé le carnet d'adresse et
demande si on autorise d'envoyer le message.

Voisi mon code que j'utilise.
Public Sub SendMessage(destinataire As String, _
Sujet As String, _
Corps As String, _
Optional CopieCC As String, _
Optional PièceJointe As String)

Dim CC As Variant
Dim I As Integer
Dim OL_App As New Outlook.Application
Dim OL_Attach As Outlook.Attachment
Dim OL_Recipient As Outlook.Recipient
Dim OL_Msg As Outlook.MailItem

Set OL_Msg = OL_App.CreateItem(olMailItem)
With OL_Msg
CC = Split(destinataire, ";")
For I = LBound(CC) To UBound(CC)
Set OL_Recipient = .Recipients.Add(CC(I))
OL_Recipient.Type = olTo
Next I
If Not IsMissing(CopieCC) Then
CC = Split(CopieCC, ";")
For I = LBound(CC) To UBound(CC)
If CC(I) <> "" Then
Set OL_Recipient = .Recipients.Add(CC(I))
OL_Recipient.Type = olCC
End If
Next I
End If
.Subject = Sujet
.Body = Corps
.Importance = olImportanceHigh
If Not IsMissing(PièceJointe) Then
CC = Split(PièceJointe, ";")
For I = LBound(CC) To UBound(CC)
If CC(I) <> "" Then
Set OL_Attach = .Attachments.Add(CC(I))
End If
Next I
End If
For Each OL_Recipient In .Recipients
OL_Recipient.Resolve
If Not OL_Recipient.Resolve Then
OL_Msg.Display
Else
.Display ' choisir display ou send
' .Send
End If
Next
End With
OL_Msg.Send
Set OL_Msg = Nothing
Set OL_App = Nothing
Set OL_Attach = Nothing
Set OL_Recipient = Nothing
End Sub

Merci de vos aides.