Discussion :

[toftrem]

Bonjour la communauté
Qqun peut' il m'aider car je sèche alors que mon besoin me parait simple à réaliser mais je suis vraiment nul en VBA:

J'utilise cette macro pour déplacer des emails selectionnés dans un sous dossier de ma BAL:

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
'Outlook VB Macro to move selected mail item(s) to a target folder
Sub MoveToFiled()
On Error Resume Next
 
Dim ns As Outlook.NameSpace
Dim moveToFolder As Outlook.MAPIFolder
Dim objItem As Outlook.MailItem
 
Set ns = Application.GetNamespace("MAPI")
 
'Define path to the target folder
Set moveToFolder = ns.Folders("contact@ingetech.fr (1)").Folders("EDV")
 
If Application.ActiveExplorer.Selection.Count = 0 Then
   MsgBox ("No item selected")
   Exit Sub
End If
 
If moveToFolder Is Nothing Then
   MsgBox "Target folder not found!", vbOKOnly + vbExclamation, "Move Macro Error"
End If
 
For Each objItem In Application.ActiveExplorer.Selection
   If moveToFolder.DefaultItemType = olMailItem Then
      If objItem.Class = olMail Then
         objItem.Move moveToFolder
      End If
  End If
Next
 
Set objItem = Nothing
Set moveToFolder = Nothing
Set ns = Nothing
 
End Sub

Cela fonctionne très bien mais je voudrai au préalable copier l'email sélectionné dans un autre dossier d'une autre BAL dans mon OUTLOOK 2013....

Est-il possible d'ajouter un autre SUB copy avant de traiter le déplacement du mail ?

Merci par avance

[Oliv-]

Bonjour,

il faut utiliser la fonction copy + Move, la copie se faisant dans le même dossier

Code :

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

1
2
 Set myCopiedItem = objItem.Copy
    myCopiedItem.Move myNewFolder

[toftrem]

merci pour la réponse
Justement je veux copier dans un autre dossier (d'une autre BAL)
Possible d'inserer un code avant?

[Oliv-]

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
Sub MoveToFiled()
    On Error Resume Next
 
    Dim ns As Outlook.NameSpace
    Dim moveToFolder As Outlook.MAPIFolder
    Dim objItem As Outlook.MailItem
 
    Set ns = Application.Session
 
    'Define path to the target folder
    Set moveToFolder = ns.Folders("contact@ingetech.fr (1)").Folders("EDV")
 
 
    'ici tu choisi le dossier de destinataion de la copie à ADAPTER
    Set myNewFolder = ns.Folders("contact@ingetech.fr (1)").Folders("EDV")
    'ou en choisissant le dossier directement
    'Set myNewFolder = ns.pickfolder
 
 
    If Application.ActiveExplorer.Selection.count = 0 Then
        MsgBox ("No item selected")
        Exit Sub
    End If
 
    If moveToFolder Is Nothing Then
        MsgBox "Target folder not found!", vbOKOnly + vbExclamation, "Move Macro Error"
    End If
 
    For Each objItem In Application.ActiveExplorer.Selection
        If moveToFolder.DefaultItemType = olMailItem Then
            If objItem.Class = olMail Then
 
               'ICI ON FAIT UNE COPIE
                Set myCopiedItem = objItem.Copy
                myCopiedItem.MOVE myNewFolder
 
                objItem.MOVE moveToFolder
            End If
        End If
    Next
 
    Set objItem = Nothing
    Set moveToFolder = Nothing
    Set ns = Nothing
 
End Sub

[toftrem]

Merci infiniment !!!