CDO : problemes pour ouvrir une 2eme messagerie

Question

Bonjour,

J'utilise CDO 2.1 sous outlook afin de récupérer les "header' d'un message. Mon sousic est que j'arrive parfaitement à mon but mais uniquement pour les messages lus dans le folder Outlook actuellement ouvert (sélectionné). J'ai deux comptes mail ouvert sous ma session outlook et je souhaiterais définir à l'avance sous quel compte (Inbox), les messages doivent être lus afin d'en recuperer les "headers".

Voici mon bout de code :

Sub CurMail()

Call InternetHeaders

End Sub
Public Function InternetHeaders(Optional strUser As String "", Optional blOnce As Boolean False) As String

'Requires a project reference to CDO 1.21 (CDO.DLL)

Dim objOutlook As Outlook.Application

Dim objItem As Outlook.MailItem

Dim objCDO As MAPI.Session

Dim objMessage As MAPI.Message

Dim objFields As MAPI.Fields

Dim strID As String

Const CdoPR_TRANSPORT_MESSAGE_HEADERS = &H7D001E

Const CdoPR_TRANSPORT_KEY = &HE160003

On Error Resume Next

' Instantiate an Outlook Application object.

' Set objOutlook = CreateObject("Outlook.Application")

'Find the current email item and get its EntryID

'Set objItem = objOutlook.ActiveInspector.CurrentItem

Set objExp = Outlook.ActiveExplorer

Set objSel = objExp.Selection

Set objCDO = CreateObject("MAPI.Session")

objCDO.Logon strUser, , False, False

For Each objMail In objSel

'Then set up a CDO Session using a piggy-back login

strID = objMail.EntryID

Subject1 = objMail.Subject

'Now get the item as a CDO Message

Set objMessage = objCDO.NameSpace.GetSharedDefaultFolder 'objCDO.GetMessage(strID)

'Now get the headers from the message

strTMP = (objMessage.Fields(271908894).Value & "")

If strTMP = "" Then

If blOnce Then Exit Function

strTMP = InternetHeaders("TFLITCOOR", True)

End If

InternetHeaders = strTMP

' MsgBox objMessage.Fields(271908894).Value

Debug.Print objMessage.Fields(271908894).Value

'fld.Value

If Err.Number <> 0 Then

End If

For Each fld In objMessage.Fields

Debug.Print objMessage.fld.Value

Next

Next

objCDO.Logoff

Set objFields = Nothing

Set objMessage = Nothing

Set objCDO = Nothing

Set objItem = Nothing

Set objOutlook = Nothing

End Function

Quelqu'un aurait il une idée ? en fait, avec CDO je n'arrive pas à utiliser l'equivalent de Getshareddefaultfolder comme ci-dessous :

    Dim myolApp As Outlook.Application
    Dim myNamespace As Outlook.NameSpace
    Dim myRecipient As Outlook.Recipient
    Dim CalendarFolder As Outlook.MAPIFolder
    Set myolApp = CreateObject("Outlook.Application")
    Set myNamespace = myolApp.GetNamespace("MAPI")
    
    Set myRecipient = myNamespace.CreateRecipient("TFL IT Coordination")

    
    Set objOLfolder = _
        myNamespace.GetSharedDefaultFolder _
        (myRecipient, olFolderInbox)

Merci par avance pour votre aide

Jemby

mortalino · Answer

@++ 

<hr size="2" width="100%" />
  --Mortalino--
Le mystérieux chevalier, "Provençal, le Gaulois"
<!--

jemby · Answer

Bonsoir,

aviez vous posté une réponse ? je ne vois que a++

Merci

Jemby

mortalino · Answer

Salut,

non, c'est une erreur de manipulation. Je suis au taf, avec un crétin de collègue qui a appuyé sur valider
Désolé (si un Admin passe par là, il peut supprimer mes messages)

@++ 

<hr size="2" width="100%" />
  --Mortalino--
Le mystérieux chevalier, "Provençal, le Gaulois"
<!--

CDO : problemes pour ouvrir une 2eme messagerie

3 réponses

Votre réponse

Discussions similaires