Bonjour à tous,
Y aurait-il un quelconque moyen pour injecter des fichiers .msg dans un fichier .pst ?
Voir plus bas...
Merci d'avance.
Bonne journée.
Bonjour à tous,
Y aurait-il un quelconque moyen pour injecter des fichiers .msg dans un fichier .pst ?
Voir plus bas...
Merci d'avance.
Bonne journée.
A defaut de pouvoir faire une injection, j'exporte le .msg d'un contact (après recherche de ce dernier). La recherche s'effectue à partir de son email :
Problème, la recherche ne s'effectue pas dans le bon PST. Elle se fait dans le dossier principal. Comment lui indiquer le nom du bon PST ?
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 Dim objApp As Application Dim objNS As NameSpace Dim objContacts As MAPIFolder Dim colItems As Items Dim objItem As Object Dim strAddress As String Dim strWhere As String Dim blnFound As Boolean ' get folder to search Set objApp = CreateObject("Outlook.Application") Set objNS = objApp.GetNamespace("MAPI") Set objContacts = objNS.GetDefaultFolder(olFolderContacts) strWhere = "[Email1Address] <> vbNullString " & _ "Or [Email2Address] <> vbNullString " & _ "Or [Email3Address] <> vbNullString " Set colItems = objContacts.Items.Restrict(strWhere) ' get address to search for strAddress = InputBox("Find an Address in Contacts") If strAddress <> "" Then colItems.SetColumns ("Email1Address") For Each objItem In colItems ' must test for item type to avoid distribution lists If TypeName(objItem) = "ContactItem" Then If InStr(objItem.Email1Address, strAddress) > 0 Then objItem.Display blnFound = True Exit For ElseIf InStr(objItem.Email2Address, strAddress) > 0 Then objItem.Display blnFound = True Exit For ElseIf InStr(objItem.Email3Address, strAddress) > 0 Then objItem.Display blnFound = True Exit For End If End If Next End If If Not blnFound Then MsgBox "Not Found" End If objItem.SaveAs ("PATH") Set objItem = Nothing Set colItems = Nothing Set objContacts = Nothing Set objNS = Nothing Set objApp = Nothing
Bonjour,
Pour choisir le fichier PST il faut remplacer le code :
Par :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2 Set objNS = objApp.GetNamespace("MAPI") Set objContacts = objNS.GetDefaultFolder(olFolderContacts)
Reste plus qu'à exporter le résultat
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2 Set objContacts = objApp.GetNamespace("MAPI").Folders("NOM DU DOSSIER PRINCIPAL DE VOTRE PST") Set objContacts = objContacts.Folders("NOM DU SOUS DOSSIER (EXEMPLE NOM DU CARNET D'ADRESSE")
J'arrive à effectuer une recherche mais impossible d'exporter le contact, pourtant la syntaxe semble correcte.
Il s'agit de la ligne : objItem.SaveAs "C:\file.msg" qui passe mais apparement ne fait rien.
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 FindEmailAddressInContacts() Dim objApp As Application Dim objNS As NameSpace Dim objContacts As MAPIFolder Dim colItems As Items Dim objItem As Object Dim strAddress As String Dim strWhere As String Dim blnFound As Boolean ' get folder to search Set objApp = CreateObject("Outlook.Application") 'Set objNS = objApp.GetNamespace("MAPI") Set objContacts = objApp.GetNamespace("MAPI").Folders("Contacts G") Set objContacts = objContacts.Folders("Contacts") 'Set objContacts = objNS.GetDefaultFolder(olFolderContacts) strWhere = "[Email1Address] <> vbNullString " Set colItems = objContacts.Items.Restrict(strWhere) ' get address to search for strAddress = InputBox("Find an Address in Contacts") If strAddress <> "" Then colItems.SetColumns ("Email1Address") For Each objItem In colItems ' must test for item type to avoid distribution lists If TypeName(objItem) = "ContactItem" Then If InStr(objItem.Email1Address, strAddress) > 0 Then 'objItem.Display blnFound = True objItem.SaveAs "C:\file.msg" Exit For End If End If Next End If If Not blnFound Then MsgBox "Not Found" End If Set objItem = Nothing Set colItems = Nothing Set objContacts = Nothing Set objNS = Nothing Set objApp = Nothing End Sub
Une idée ?
L'exportation est réussie.
En fait il faut utiliser une variable de type ContactItem plutôt que Item pour que le SaveAs fonctionne bien.
Voici le code :
Manque plus que l'importation...
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 Sub FindEmailAddressInContacts() Dim objApp As Application Dim objNS As NameSpace Dim objFolders As MAPIFolder Dim colItems As Items Dim strAddress As String Dim strWhere As String Dim blnFound As Boolean Dim objContact As ContactItem ' get folder to search Set objApp = CreateObject("Outlook.Application") 'Set objNS = objApp.GetNamespace("MAPI") Set objFolders = objApp.GetNamespace("MAPI").Folders("Contacts G") Set objFolders = objFolders.Folders("Contacts") 'Set objContacts = objNS.GetDefaultFolder(olFolderContacts) strWhere = "[Email1Address] <> vbNullString " Set colItems = objFolders.Items.Restrict(strWhere) ' get address to search for strAddress = InputBox("Find an Address in Contacts") If strAddress <> "" Then For Each objContact In colItems ' must test for item type to avoid distribution lists If TypeName(objContact) = "ContactItem" Then If InStr(objContact.Email1Address, strAddress) > 0 Then blnFound = True objContact.SaveAs "C:\file.msg" Exit For End If End If Next End If If Not blnFound Then MsgBox "Not Found" End If Set objContact = Nothing Set colItems = Nothing Set objFolders = Nothing Set objNS = Nothing Set objApp = Nothing End Sub
L'importation continue dans un nouveau sujet...
Vous avez un bloqueur de publicités installé.
Le Club Developpez.com n'affiche que des publicités IT, discrètes et non intrusives.
Afin que nous puissions continuer à vous fournir gratuitement du contenu de qualité, merci de nous soutenir en désactivant votre bloqueur de publicités sur Developpez.com.
Partager