Discussion :

[Darktrouble]

Bonjour,
Je réouvre un topic sur le code de renvoie d'email de Oliv-.
J'ai répondu à un topic résolu de 2007, mais dans le doute, j'en fais un nouveau sujet.

Donc voilà le bout de code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Sub EnvoiTouteLaSelection()
Dim MonOutlook As Outlook.Application
Dim Mail As Object
Dim LeMail As Outlook.MailItem
Dim LesMails As Object
Set MonOutlook = Outlook.Application 
Set LesMails = MonOutlook.ActiveExplorer.Selection
For Each LeMail In LesMails
LeMail.send
Next LeMail
Set LesMails = Nothing
End Sub

J'obtiens une

erreur 13 : incompatibilité de type.

Si quelqu'un a la moindre idée, merci d'avance !

[Oliv-]

Peut être avec cela, mais je suis un peu rouillé sur OUTLOOK étant depuis 3 ans sur LOTUS

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
'---------------------------------------------------------------------------------------
' Procedure : RenvoiLaPJdeTouteLaSelection
' Author    : Oliv'
' Date      : 26/11/2008
' Purpose   :
'---------------------------------------------------------------------------------------
'
Sub RenvoiLaPJdeTouteLaSelection()
    Dim MonOutlook As Outlook.Application
    Dim Mail   As Object
    Dim LeMail As Outlook.MailItem
    Dim LesMails As Object
    Set MonOutlook = Outlook.Application
    Set LesMails = MonOutlook.ActiveExplorer.Selection
    For Each LeMail In LesMails
        If LeMail.subject Like "Notification  d'état  de  remise  (échec)" Then
 
            Dim pj As Attachment
            For Each pj In LeMail.Attachments
                If Right(UCase(pj.FileName), 4) = ".MSG" Then
                    LeFichier = "c:\temp\ziptemp\" & pj.FileName
                    pj.SaveAsFile (LeFichier)
                    Ouverture_msg (LeFichier)
                    Kill LeFichier
                End If
            Next pj
            LeMail.Delete
        End If
    Next LeMail
    Set LesMails = Nothing
    MsgBox "Opération terminée"
End Sub
 
Sub Ouverture_msg(LeFichier As String)
'ouvrir un .msg d'un dossier de l'explorateur
    Set myolApp = Outlook.Application
    shellcommande = """C:\Program Files\Microsoft Office\OFFICE11\OUTLOOK.EXE"" /f """ & LeFichier & """"
    RetVal = Shell(shellcommande, 1)
    DoEvents
    Set myItem = myolApp.ActiveInspector.CurrentItem
    'MsgBox "Sujet: " & myItem.subject & vbCr & "reçu le : " & myItem.ReceivedTime & vbCr & "A: " & myItem.To & vbCr & "Email Exp: " & myItem.SenderEmailAddress & vbCr & "PJ: " & myItem.Attachments.Count
    myItem.Categories = "Idées"
    myItem.Send
    On Error Resume Next
    myItem.Close 0
    On Error GoTo 0
End Sub