exportation du fichier vcf vers outlook

[bcbgtn]

Bonjour,

J'ai un fichier vCard (.vcf) sur une carte SD d'un mobile. J'essaye d'importer les contacts vers Outlook 2003, mais cela ne me prend que le 1er contact et c'est tout...

Comment faire pour les importer tous (une carte de visite par contact) ?

Merci

[Dolphy35]

Salut,

Envoyé par bcbgtn

Bonjour,

J'ai un fichier vCard (.vcf) sur une carte SD d'un mobile. J'essaye d'importer les contacts vers Outlook 2003, mais cela ne me prend que le 1er contact et c'est tout...

Comment faire pour les importer tous (une carte de visite par contact) ?

Merci

je comprend pas très bien !
un fichier vCard correspond à 1 contact, vCard => carte de visite. Si tu veux importer tous tes contacts il te faut le faire vCard par vCard.

Dolphy

[Dolphy35]

re,

ci-joint une macro permettant de lister les fichiers vcf d'un dossier et de les ajouter dans le dossier par défaut Contacts.

Attention : ce code ne fonctionne qu'avec Outlook 2007 car utilisation de 'OpenSharedItem' et 'Display' disponible seulement avec la version 2007.

Code :

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
Sub Save_vCard()
'Déclarations des variables
    Dim fsoObject As Scripting.FileSystemObject
    Dim fldDossier As Scripting.Folder
    Dim fleFichier As Scripting.File
    Dim MavCard As ContactItem
    Dim MonDossier As Folder
    Dim MonApp As New Outlook.Application
    Dim MonNamespace As Outlook.NameSpace
 
'charge le répertoire dans la variable
    strRepertoire = "C:\temp"
 
    'instancie les FSO
    Set fsoObject = CreateObject("Scripting.FileSystemObject")
    Set fldDossier = fsoObject.GetFolder(strRepertoire)
    'Instancie l'espace "MAPI" - Session
    Set MonNamespace = MonApp.GetNamespace("MAPI")
 
    'Test si fichier *.vcf dans le dossier et ajout de clui-ci
    If (fldDossier.Files.Count > 0) Then
        For Each fleFichier In fldDossier.Files
            If (InStr(1, fleFichier.Name, ".vcf", 1) > 0) Then
                Set MavCard = MonNamespace.OpenSharedItem(strRepertoire & "\" & fleFichier.Name)
                MavCard.Save
            End If
        Next
    End If
 
    'Récupère le dossier Contacts par défaut
    Set MonDossier = MonNamespace.GetDefaultFolder(olFolderContact)
    'Affichage d'outlook dans le dossier
    MonDossier.Display
 
    'Vide les instances
    Set fsoObject = Nothing
    Set fldDossier = Nothing
    Set MonNamespace = Nothing
    Set MavCard = Nothing
    Set MonDossier = Nothing
 
End Sub

[Oliv-]

Salut
Pour les versions antérieurs à 2007 essayer dans la boucle "For Each fleFichier" avec
"C:\PROGRA~1\MICROS~2\OFFICE11\OUTLOOK.EXE" /v "%1"
où %1 est le fichier

doevents

Code :

Set MavCard = MonApp.ActiveInspector.CurrentItem

[hibou78]

Si comme moi vous avez besoin d'importer en masse les contacts issus de votre Palm Desktop lors d'une migration vers Outlook 2007, voici une petite macro à adapter qui s'inspire des travaux ci-dessus...

Cà évite d'acheter certains outils sharewares à 20$ comme vcard4outlook, vcardWizard,... pour quelquechose d'excessivement simple...

Have fun !

Code :

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
 
Sub ImportMultipleVcf()
    Dim toggle As Boolean
    Dim card As ContactItem
    Dim app As New Outlook.Application
    Dim namespace As Outlook.namespace
    Dim temporary_filename As String
 
 
    toggle = False
    temporary_filename = "c:\temp\tmp.vcf"
    Set namespace = app.GetNamespace("MAPI")
 
    ' Changer ici le nom du fichier vcf multiple issu de Palm Desktop
    Open "c:\temp\all.vcf" For Input As #1
    Do While Not EOF(1)
        Line Input #1, inputdata
        If inputdata = "BEGIN:VCARD" Then
            toggle = True
            Open temporary_filename For Output As #2
        End If
        If toggle Then Print #2, inputdata
        If inputdata = "END:VCARD" Then
            Close #2
            toggle = False
            Set card = namespace.OpenSharedItem(temporary_filename)
            card.Save
        End If
    Loop
    Close #1
 
End Sub