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
Merci par avance de l'attention porté à ce post !
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
Partager