Reccuperation automatique des contacts publics d outlook
Reccuperation automatique des contacts publics d outlook - VB/VBA/VBS - Programmation
MarshPosté le 14-03-2007 à 16:05:52
kikou a tous!!
J ai fais un ti code pour extraire les contacts du dossier public d outlook. Ca marche super bien sur les 249 premiers contacts mais apres il ne les reconné plus comme des ContactItems!! Et pourtant yen a deux bon milliers qui suivent...
Si vous avez une idée du pb... Merci d'avance!
Voici le code....
Imports System.IO Imports System.Reflection
Module Module1
Sub Main() Dim oOL As Microsoft.Office.Interop.Outlook.Application Dim oNS As Microsoft.Office.Interop.Outlook.NameSpace Dim oFolder As Microsoft.Office.Interop.Outlook.MAPIFolder Dim oItems As Microsoft.Office.Interop.Outlook.Items Dim oContact As Microsoft.Office.Interop.Outlook.ContactItem Dim n As Integer
oOL = New Microsoft.Office.Interop.Outlook.Application oNS = oOL.GetNamespace("MAPI" ) oFolder = oNS.Folders("Dossiers publics" ) oFolder = oFolder.Folders("Tous les dossiers publics" ) oFolder = oFolder.Folders("CONTACTS" ) oItems = oFolder.Items n = 0
Dim SW As New StreamWriter("MonFichier.txt" )
For Each oContact In oItems
Try SW.WriteLine(oContact.FullName) Catch SW.WriteLine("!!!!!!!!!!an Error Occured!!!!!!!!!!" ) End Try
Marsh Posté le 14-03-2007 à 16:05:52
kikou a tous!!
J ai fais un ti code pour extraire les contacts du dossier public d outlook. Ca marche super bien sur les 249 premiers contacts mais apres il ne les reconné plus comme des ContactItems!! Et pourtant yen a deux bon milliers qui suivent...
Si vous avez une idée du pb... Merci d'avance!
Voici le code....
Imports System.IO
Imports System.Reflection
Module Module1
Sub Main()
Dim oOL As Microsoft.Office.Interop.Outlook.Application
Dim oNS As Microsoft.Office.Interop.Outlook.NameSpace
Dim oFolder As Microsoft.Office.Interop.Outlook.MAPIFolder
Dim oItems As Microsoft.Office.Interop.Outlook.Items
Dim oContact As Microsoft.Office.Interop.Outlook.ContactItem
Dim n As Integer
oOL = New Microsoft.Office.Interop.Outlook.Application
oNS = oOL.GetNamespace("MAPI" )
oFolder = oNS.Folders("Dossiers publics" )
oFolder = oFolder.Folders("Tous les dossiers publics" )
oFolder = oFolder.Folders("CONTACTS" )
oItems = oFolder.Items
n = 0
Dim SW As New StreamWriter("MonFichier.txt" )
For Each oContact In oItems
Try
SW.WriteLine(oContact.FullName)
Catch
SW.WriteLine("!!!!!!!!!!an Error Occured!!!!!!!!!!" )
End Try
Next
SW.Close()
oOL = Nothing
oNS = Nothing
oFolder = Nothing
oItems = Nothing
oContact = Nothing
End Sub
End Module