Bonjour,

plutôt orienté php, je dois pour un stage développer une macro VBA pour Outlook 2007 mais je misère comme pas 2. L'objectif de la macro est que lorsqu'un un email est envoyé sur l'adresse fax@amg.com, celui est en fait redirigé sur une imprimante-fax, qui envoie le mail sous forme de fax.
Pour ce faire je récupére les données du mail j'insère dans un doc word (ouvert via vba) et j'envoie sur l'imprimante. Alors dans les grandes lignes ça fonctionne sans soucis sauf sur 2 points :
- la gestion des pièces jointes (rien trouvé de fonctionnel)
- déplacement dans dossier autre qu'envoie (essai de plusieurs syntaxes rien ne passe)
Si jamais vous avez des idées, n'hésitez pas

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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
 
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
 
 
    Dim olApp As New Outlook.Application
    Dim wdApp As Word.Application
    Dim wdFax As Word.Document
 
    Dim mail, mailSub As Object
    Dim pjCount, i As Integer
 
    Dim ActivePrinter, DefaultPrinter As String
 
    Dim nameSpace As Outlook.nameSpace
    Dim fldFax, fldDefault As Outlook.MAPIFolder
 
 
'//check before sending
Set mail = olApp.ActiveInspector.CurrentItem
If (mail.SendUsingAccount = "fax@amg.lan") Then
    If MsgBox("Vous allez envoyer un fax. Continuer ?", vbQuestion + vbOKCancel) = vbCancel Then
        Cancel = True
    Else
        If (mail.Subject = "") Then
            If MsgBox("Pas de sujet. Continuer ?", vbQuestion + vbOKCancel) = vbCancel Then
                Cancel = True
            End If
        Else
            '//creating worddoc
            Set wdApp = New Word.Application
            Set wdFax = wdApp.Documents.Add
            With wdApp.Selection
                .TypeText mail.Subject
                .TypeText mail.Body
            End With
            wdApp.Selection.EndKey Unit:=wdStory, Extend:=wdMove
 
        '//add attachements
        pjCount = mail.Attachments.Count
        If (pjCount > 0) Then
            For i = 1 To pjCount
                wdApp.Selection.InsertBreak (olApp.mail.Attachments)
                wdApp.Selection.EndKey Unit:=wdStory, Extend:=wdMove
            Next i
        End If
 
        '//send to print
        DefaultPrinter = wdApp.ActivePrinter
        wdApp.ActivePrinter = "\\WS-AMG-003\konica minolta c360 fax"
        wdApp.PrintOut
        wdApp.ActivePrinter = DefaultPrinter
        wdApp.ActiveDocument.Close (Word.WdSaveOptions.wdDoNotSaveChanges)
        wdApp.quit
 
        '//move to fax folder
        Set nameSpace = olApp.GetNamespace("MAPI")
        Set fldDefault = nameSpace.GetDefaultFolder(olFolderOutbox)
        '/Set fldFax = nameSpace.Folders("Dossiers Personnels").Folders("Boîte d'envoi").Folders.Add("fax")
        Set fldFax = fldDefault.Folders("fax")
        mail.Move fldFax
 
        End If
    End If
End If
End Sub
Merci par avance de l'attention porté à ce post !