Bonjour,

Je désire copier le contenu de mes contacts vers un répertoire contact déjà existant dans les dossiers publics.
Ce script fonctionne, mais j'ai une erreur sur la ligne "Set objItem = Application.ActiveExplorer.Selection.Item(1)"
Si je ne suis dans le répertoire au préalable.

Y a-t-il moyen de faire en sorte que la copie se fasse sans forcément devoir être dans le carnet d'adresses pour la copie ?

Merci à vous,


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
Sub Movecopycontacts()
 
    Dim objOutlook As Outlook.Application
    Dim objNamespace As Outlook.NameSpace
    Dim objSourceFolder As Outlook.MAPIFolder
    Dim objDestFolder As Outlook.MAPIFolder
    Dim objItem As ContactItem
 
    Set objOutlook = Application
    Set objNamespace = objOutlook.GetNamespace("MAPI")
    Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderContacts)
    Set objItem = Application.ActiveExplorer.Selection.Item(1)
    Set objDestFolder = objNamespace.Folders("Public folder - oky@test.com").Folders("all public folder").Folders("test")
 
    objItem.Move objDestFolder
 
    Set objDestFolder = Nothing
End Sub