Erreur 438Résolu

Question

Bonjour,

Il y a quelques semaines j'ai développer une petite fonction dans un formulaire en access qui va chercher les mails dans une boite spécifique d'outlook et va vérifier et chercher des info de la base.
Jusqu'à présent ca fonctionnait, mais depuis aujourd'hui rien va plus!
J'ai chercher sur internet et trouver que cela pourrait venir de la securité des macro en outlook. Le probleme c'est que le service concerné, m'assure qu'ils n'y a pas eu de changement (saurait pas le confirmer, j'avoue ne pas avoir été regarder auparravant à quel status était la sécurité).
Pourtant j'ai bon regarder et ne trouve pas pourquoi j'ai maintenant l'erreur "Object doesn't support this property or method (Error 438)" qui apparait.

Mon code est le suivant:

Private Sub Bt_ExTransMail_Click()

Dim olApp As New Outlook.Application
Dim olFold As Outlook.MAPIFolder
Dim olItems As Outlook.Items
Dim olItem, nwItem As Outlook.MailItem
Dim Cmpt1, Cmpt2 As Integer
Dim Rcd As Long
Dim rst As DAO.Recordset

Cmpt1 = 0
Cmpt2 = 0

Set rst = CurrentDb.OpenRecordset("Qry_Supp_Pers")

rst.MoveFirst

Set olApp = CreateObject("Outlook.Application")
Set olFold = olApp.GetNamespace("MAPI").Folders("Mailbox - Support")
Set olItems = olFold.Folders("Inbox").Items.Restrict("[ReceivedTime] > '" & Date - 5 & "'") 

For i = olItems.Count To 1 Step -1
   Rcd = 0
   Set olItem = olItems.Item(i)
   rst.MoveFirst
   Do Until rst.EOF
      If olItem.Subject Like "*" & rst.Fields("PROD_NUM") & "*" Then
         Rcd = rst.AbsolutePosition
      End If
      rst.MoveNext
   Loop
   If Rcd = 0 Then
      rst.MoveFirst
      Do Until rst.EOF
         If olItem.Subject Like "*" & rst.Fields("PROD_NAME") & "*" Then
            Rcd = rst.AbsolutePosition
         End If
         rst.MoveNext
      Loop
   End If
   rst.MoveFirst
   If Rcd > 0 Then
      rst.Move Rcd
      If (rst.Fields("Account") = "xxxx") Or IsEmpty(rst.Fields("EmailAddress")) Then
         olItem.Move olFold.Folders("AOR/non deliv")
         Cmpt2 = Cmpt2 + 1
      Else
         Set nwItem = olItem.Forward      ' ***** C'est Ici qu'il me fait l'erreur   ****
         nwItem.Recipients.Add rst.Fields("EmailAddress")
         nwItem.DeleteAfterSubmit = True
         nwItem.Send
         olItem.Delete
         Set nwItem = Nothing
         Cmpt1 = Cmpt1 + 1
      End If
   End If
Next
Me.NbMailForw.Value = Cmpt1
Me.NbMailMove.Value = Cmpt2

Set olApp = Nothing
Set olFold = Nothing
Set olItems = Nothing
Set olItem = Nothing

End Sub

Hors je confirme qu'avant j'ai jamais eu d'erreur là, et que tout est bien déclaré.
La référence Outllook est bien déclaré, vu que j'ai d'autres fonctions qui elles fonctionnent toujours.
Pour info: Access 2003, mais les DB sont en 2000; Outlook 2003 sous XP.

Maintenant en vous écrivant je constate que le SP3 de Office à été fait, alors, éventuellement est-ce quelqu'un aurait vent d'un changent à ce sujet.

Merci d'avance.

Thanae

thanae · Accepted Answer

Ce matin, bizarrement, après avoir laisser de cote ce probleme, je reteste et la ca fonctionne!!! grrrrrrr 
Donc, désolée du dérangement, mais ce doit etre les admins exchange qui ont du faire qqch au niveau securité ou autres, sans nous en parler (vive la communication inter-services!!! ).

Thanae

cs_MPi · Answer

Quand tu déclares tes variables, met le type pour chacune d'elles

exemple de ce que tu écris:
Dim olItem, nwItem As Outlook.MailItem

Dim Cmpt1, Cmpt2 As Integer

olitem = Variant (pas MailItem)
Cmpt1 = Variant (pas Integer)

Peut-être que ça vient de là ...(?)

Est-ce que tu as ajouté nwItem récemment ? Est-ce depuis ce temps que ça plante ?

MPi²
Pour ceux qui programment sous Office, n'oubliez pas qu'il existe un forum dédié à ces applications VBA....... ICI

thanae · Answer

Merci MPi pour ta réponse. 
J'ai essaye ce que tu me propose, mais ca donne la meme erreur.
Je ne comprend pas pourquoi il n'accepte pas le item.forward.
J'ai essaye declarant comme object, sans declarer, enfin de toutes les facon, et rien a faire.
J'attends des nouvelles de l'equipe System/Echange, pour voir si il y a pas eu d'autres patch d'installer ces derniers jours.

cs_MPi · Answer

As-tu modifié ta méthode de "connexion" à Outlook ?
C'est-à-dire, est-ce que tu utilises CreateObject plutôt que New Outlook.Application depuis peu ?

Avec CreateObject, il est préférable (essentiel ?) d'utiliser As Object plutôt que As Outlook.Application ou MailItem, disons

exemple sans référence à Outlook:
    Dim OutlookApp As Object    'plutôt que New Outlook.Application
    Dim NewMail As Object       'plutôt que Outlook.MailItem

    Set OutlookApp = CreateObject("Outlook.Application")
    Set NewMail = OutlookApp.CreateItem(0)  '(olMailItem)=0

MPi²
Pour ceux qui programment sous Office, n'oubliez pas qu'il existe un forum dédié à ces applications VBA....... ICI

Erreur 438

4 réponses

Votre réponse

Discussions similaires