XL 2010 import fichier .vcf dans excel

S

sri75

XLDnaute Occasionnel
Bonjour, je récupère des fichiers .vcf sur des sites et je voudrais les importer ensuite via une macro dans Excel, en récupérant chaque donnée dans une cellule distincte si possible, et sur une ligne et non en colonne

j'ai beau écumer les forums je ne trouve rien de satisfaisant par rapport à mon besoin, je mets en pj un exemple ( j'ai rajouté un .txt à l'extension .vcf pour pouvoir la télécharger )

Je vous remercie tous par avance pour votre aide et vos conseils.

Bonne journée
 

Pièces jointes

  • Laurianne_GUILLOT.vcf.txt
    218 bytes · Affichages: 16
Trier par date Trier par votes
wDog66

wDog66

XLDnaute Occasionnel
Bonjour sri75

Peut-être quelque chose comme ça (dixit GPT 😜)
VB: 
Sub ImportVCF()
    Dim filePath As String
    Dim fileNum As Integer
    Dim fileLine As String
    Dim name As String
    Dim phone As String
    Dim email As String
    Dim ws As Worksheet
    Dim row As Long
    
    ' Définir le chemin du fichier VCF
    filePath = "C:\path\to\your\file.vcf"
    
    ' Ouvrir le fichier VCF
    fileNum = FreeFile
    Open filePath For Input As fileNum
    
    ' Créer une nouvelle feuille de calcul pour les données importées
    Set ws = ThisWorkbook.Worksheets.Add
    ws.Name = "VCF Data"
    
    ' Initialiser la première ligne
    row = 1
    
    ' Lire chaque ligne du fichier VCF
    Do While Not EOF(fileNum)
        Line Input #fileNum, fileLine
        
        ' Vérifier si la ligne contient les informations pertinentes
        If InStr(fileLine, "FN:") > 0 Then
            name = Mid(fileLine, InStr(fileLine, "FN:") + 3)
        ElseIf InStr(fileLine, "TEL:") > 0 Then
            phone = Mid(fileLine, InStr(fileLine, "TEL:") + 4)
        ElseIf InStr(fileLine, "EMAIL:") > 0 Then
            email = Mid(fileLine, InStr(fileLine, "EMAIL:") + 6)
        ElseIf InStr(fileLine, "END:VCARD") > 0 Then
            ' Lorsque l'on atteint la fin d'une vCard, écrire les données dans Excel
            ws.Cells(row, 1).Value = name
            ws.Cells(row, 2).Value = phone
            ws.Cells(row, 3).Value = email
            
            ' Passer à la ligne suivante
            row = row + 1
            
            ' Réinitialiser les variables
            name = ""
            phone = ""
            email = ""
        End If
    Loop
    
    ' Fermer le fichier VCF
    Close fileNum
    
    MsgBox "Importation terminée!"
End Sub
 
Vote positif 0 Vote négatif
S

sri75

XLDnaute Occasionnel
wDog66 à dit:
Bonjour sri75

Peut-être quelque chose comme ça (dixit GPT 😜)
VB: 
Sub ImportVCF()
    Dim filePath As String
    Dim fileNum As Integer
    Dim fileLine As String
    Dim name As String
    Dim phone As String
    Dim email As String
    Dim ws As Worksheet
    Dim row As Long
   
    ' Définir le chemin du fichier VCF
    filePath = "C:\path\to\your\file.vcf"
   
    ' Ouvrir le fichier VCF
    fileNum = FreeFile
    Open filePath For Input As fileNum
   
    ' Créer une nouvelle feuille de calcul pour les données importées
    Set ws = ThisWorkbook.Worksheets.Add
    ws.Name = "VCF Data"
   
    ' Initialiser la première ligne
    row = 1
   
    ' Lire chaque ligne du fichier VCF
    Do While Not EOF(fileNum)
        Line Input #fileNum, fileLine
       
        ' Vérifier si la ligne contient les informations pertinentes
        If InStr(fileLine, "FN:") > 0 Then
            name = Mid(fileLine, InStr(fileLine, "FN:") + 3)
        ElseIf InStr(fileLine, "TEL:") > 0 Then
            phone = Mid(fileLine, InStr(fileLine, "TEL:") + 4)
        ElseIf InStr(fileLine, "EMAIL:") > 0 Then
            email = Mid(fileLine, InStr(fileLine, "EMAIL:") + 6)
        ElseIf InStr(fileLine, "END:VCARD") > 0 Then
            ' Lorsque l'on atteint la fin d'une vCard, écrire les données dans Excel
            ws.Cells(row, 1).Value = name
            ws.Cells(row, 2).Value = phone
            ws.Cells(row, 3).Value = email
           
            ' Passer à la ligne suivante
            row = row + 1
           
            ' Réinitialiser les variables
            name = ""
            phone = ""
            email = ""
        End If
    Loop
   
    ' Fermer le fichier VCF
    Close fileNum
   
    MsgBox "Importation terminée!"
End Sub
Cliquez pour agrandir...
Bonjour, la macro plante a la ligne ws.Name = "VCF Data"

Merci
 
Vote positif 0 Vote négatif
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Sri, wDog,
Un autre exemple avec :
VB: 
Sub Import()
Dim NomFichier$, N%, T, Tablo, i%
NomFichier = Application.GetOpenFilename("Text files (*.vcf*), *.vcf*", , "CHOISSISSEZ LE FICHIER A TRAITER", , False)
If NomFichier = "Faux" Then Exit Sub
ReDim T(1, 20)          ' Déclare array
Fichier = FreeFile
Open NomFichier For Input As #Fichier
Line Input #Fichier, Ligne
Close #Fichier          ' Fermeture fichier texte
' Restitution du tableau séparateur chr(10
Tablo = Split(Ligne, Chr(10))
For i = 0 To UBound(Tablo)
    On Error Resume Next
    Cells(1, i + 1) = Replace(Split(Tablo(i), ":")(1), ";", " ") ' Ligne 1 à modifier suivant besoin
Next i
End Sub
A adapter suivant votre contexte, traitement de multiples fichiers ou autre.
 

Pièces jointes

  • sri75.xlsm
    15.6 KB · Affichages: 2
Vote positif 0 Vote négatif
S

sri75

XLDnaute Occasionnel
Ca marche pour le stockage mais c'est le decoupage qui pose pb

ca fonctionne jusqu'a name, ca stoke toute les infos, puis ca passe à end if, loop et puis ca ferme la macro

en fait name contient toutes des données

If InStr(fileLine, "FN:") > 0 Then
name = Mid(fileLine, InStr(fileLine, "FN:") + 3)
ElseIf InStr(fileLine, "TEL:") > 0 Then
phone = Mid(fileLine, InStr(fileLine, "TEL:") + 4)
ElseIf InStr(fileLine, "EMAIL:") > 0 Then
email = Mid(fileLine, InStr(fileLine, "EMAIL:") + 6)
ElseIf InStr(fileLine, "END:VCARD") > 0 Then
 
Vote positif 0 Vote négatif
S

sri75

XLDnaute Occasionnel
sylvanu à dit:
Bonjour Sri, wDog,
Un autre exemple avec :
VB: 
Sub Import()
Dim NomFichier$, N%, T, Tablo, i%
NomFichier = Application.GetOpenFilename("Text files (*.vcf*), *.vcf*", , "CHOISSISSEZ LE FICHIER A TRAITER", , False)
If NomFichier = "Faux" Then Exit Sub
ReDim T(1, 20)          ' Déclare array
Fichier = FreeFile
Open NomFichier For Input As #Fichier
Line Input #Fichier, Ligne
Close #Fichier          ' Fermeture fichier texte
' Restitution du tableau séparateur chr(10
Tablo = Split(Ligne, Chr(10))
For i = 0 To UBound(Tablo)
    On Error Resume Next
    Cells(1, i + 1) = Replace(Split(Tablo(i), ":")(1), ";", " ") ' Ligne 1 à modifier suivant besoin
Next i
End Sub
A adapter suivant votre contexte, traitement de multiples fichiers ou autre.
Cliquez pour agrandir...
Bonjour, c'est parfait, juste une précision, après l'import du 1er vcf je voudrais aller sur la ligne du dessous dans excel, pour aller chercher et importer un autre vcf et ainsi de suite.

Merci beaucoup
 
Vote positif 0 Vote négatif
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
Re,
Une possibilité simple :
VB: 
Sub Import()
Dim NomFichier$, Nligne%, N%, T, Tablo, i%
FichierSuivant:
Nligne = Nligne + 1 ' ligne ecriture
NomFichier = Application.GetOpenFilename("Text files (*.vcf*), *.vcf*", , "CHOISSISSEZ LE FICHIER A TRAITER", , False)
If NomFichier = "Faux" Then Exit Sub
ReDim T(1, 20)          ' Déclare array
Fichier = FreeFile
Open NomFichier For Input As #Fichier
Line Input #Fichier, Ligne
Close #Fichier          ' Fermeture fichier texte
' Restitution du tableau séparateur chr(10
Tablo = Split(Ligne, Chr(10))
For i = 0 To UBound(Tablo)
    On Error Resume Next
    Cells(Nligne, i + 1) = Replace(Split(Tablo(i), ":")(1), ";", " ") ' Ligne 1 à modifier suivant besoin
Next i
GoTo FichierSuivant
End Sub
Il boucle sur chaque fichier. On en sort en faisant annuler dans la demande de fichiers.
Sinon si tous vos vcf sont dans le même dossier on peut tout traiter d'un seul coup, cela dépend de votre contexte.
 

Pièces jointes

  • sri75 V2.xlsm
    15.7 KB · Affichages: 0
Vote positif 0 Vote négatif
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
Re,
Si toutes vos fiches vcf sont dans le même dossier, utilisez cette PJ, elle rapatrie d'un seul coup toutes vos fiches :
VB: 
Public Chemin$, NomFichier$, Nligne%
Sub ImportFiles()
Dim Repertoire, Fichier
[A:L].ClearContents: Nligne = 0
Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
Repertoire.Show
If Repertoire.SelectedItems.Count > 0 Then Chemin = Repertoire.SelectedItems(1) & "\" Else Exit Sub
Fichier = Dir(Chemin)
Do While Len(Fichier) > 0   'Boucle sur tous les fichiers vcf du répertoire
    NomFichier = Chemin & Fichier
    If Right(NomFichier, 4) = ".vcf" Then
        Nligne = Nligne + 1
        Import
    End If
    Fichier = Dir()
Loop
End Sub
Sub Import()
Dim N%, T, Tablo, i%
ReDim T(1, 20)          ' Déclare array
Fichier = FreeFile
Open NomFichier For Input As #Fichier
Line Input #Fichier, Ligne
Close #Fichier          ' Fermeture fichier texte
' Restitution du tableau séparateur chr(10
Tablo = Split(Ligne, Chr(10))
For i = 0 To UBound(Tablo)
    On Error Resume Next
    Cells(Nligne, i + 1) = Replace(Split(Tablo(i), ":")(1), ";", " ") 
Next i
End Sub
 

Pièces jointes

  • sri75 V3.xlsm
    16.4 KB · Affichages: 4
Vote positif 0 Vote négatif
A

alexga78

XLDnaute Occasionnel
Bonjour sri75, le forum,

Une autre solution via Power Query si les fichiers sont dans le même dossier.

VB: 
let
    fx = (tbl) =>
         [x = Table.ToList(tbl, (x)=> List.Zip(List.RemoveNulls(List.Transform(
              Lines.FromBinary(x{0},null,null,1252),
              (x)=> if x = "" then null else Text.Split(Text.Replace(x,";"," "),":"))))),
          y =  List.Transform(x,
                (x)=> Table.FromRecords({Record.RemoveFields(Record.FromList(
                 List.Transform(x{1}, Text.Trim), x{0}), {"BEGIN","END"})}))
         ] [y],
    Source = Table.SelectRows(Folder.Files("C:\New folder"), each [Extension] = ".vcf"),
    Result = Table.Combine(fx(Source))
in
    Result

Bon dimanche.
 
Dernière édition:
Vote positif 0 Vote négatif
S

sri75

XLDnaute Occasionnel
sylvanu à dit:
Re,
Si toutes vos fiches vcf sont dans le même dossier, utilisez cette PJ, elle rapatrie d'un seul coup toutes vos fiches :
VB: 
Public Chemin$, NomFichier$, Nligne%
Sub ImportFiles()
Dim Repertoire, Fichier
[A:L].ClearContents: Nligne = 0
Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
Repertoire.Show
If Repertoire.SelectedItems.Count > 0 Then Chemin = Repertoire.SelectedItems(1) & "\" Else Exit Sub
Fichier = Dir(Chemin)
Do While Len(Fichier) > 0   'Boucle sur tous les fichiers vcf du répertoire
    NomFichier = Chemin & Fichier
    If Right(NomFichier, 4) = ".vcf" Then
        Nligne = Nligne + 1
        Import
    End If
    Fichier = Dir()
Loop
End Sub
Sub Import()
Dim N%, T, Tablo, i%
ReDim T(1, 20)          ' Déclare array
Fichier = FreeFile
Open NomFichier For Input As #Fichier
Line Input #Fichier, Ligne
Close #Fichier          ' Fermeture fichier texte
' Restitution du tableau séparateur chr(10
Tablo = Split(Ligne, Chr(10))
For i = 0 To UBound(Tablo)
    On Error Resume Next
    Cells(Nligne, i + 1) = Replace(Split(Tablo(i), ":")(1), ";", " ")
Next i
End Sub
Cliquez pour agrandir...
Bonjour, le boucle fonctionne bine , par contre contrairement à la première macro les noms et prénoms ne sont pas séparés, si il était possible d'avoir les noms dans une colonne et les prénoms dans une autre ce serait parfait .
Dans le fichier joint la macro qui sépare les noms et prénoms, je n'arrive pas à l'intégrer dans la votre
Merci et bonne journée
 

Pièces jointes

  • nomprenom.xlsm
    23.8 KB · Affichages: 3
Dernière édition:
Vote positif 0 Vote négatif
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour,
sri75 à dit:
par contre contrairement à la première macro les noms et prénoms ne sont pas séparés,
Cliquez pour agrandir...
Ils ne le furent jamais ! . On avait Nom Prénom en colonne C et l'inverse en colonne D. Comme cela l'est dans le vcf.
En PJ une V4, j'ai juste rajouté à la fin de Import :
VB: 
Cells(Nligne, "D") = Split(Cells(Nligne, "C"), " ")(1)
Cells(Nligne, "C") = Split(Cells(Nligne, "C"), " ")(0)
 

Pièces jointes

  • sri75 V4.xlsm
    16.8 KB · Affichages: 4
Vote positif 0 Vote négatif
S

sri75

XLDnaute Occasionnel
sylvanu à dit:
Bonjour,

Ils ne le furent jamais ! . On avait Nom Prénom en colonne C et l'inverse en colonne D. Comme cela l'est dans le vcf.
En PJ une V4, j'ai juste rajouté à la fin de Import :
VB: 
Cells(Nligne, "D") = Split(Cells(Nligne, "C"), " ")(1)
Cells(Nligne, "C") = Split(Cells(Nligne, "C"), " ")(0)
Cliquez pour agrandir...
Bonjour, un grand merci c'est parfait , si je peux abuser un peu :)

Pour la dernière colonne adresse séparer rue cp et ville ?

3 RUE MONTALIVET 75008 PARIS

Merci beaucoup pour votre aide
 
Vote positif 0 Vote négatif
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
Re,
J'ai supprimé la colonne VCARD qui ne servait à rien, et j'ai rajouté à la fin :
VB: 
Adresse = Split(Cells(Nligne, "H"), " ")                                        'Découpage adresse
Cells(Nligne, "J") = Adresse(UBound(Adresse))                                   'Ville
Cells(Nligne, "I") = "'" & Adresse(UBound(Adresse) - 1)                         'CodPost
NbL = Len(Adresse(UBound(Adresse))) + Len(Adresse(UBound(Adresse) - 1)) + 2     'Nbcar Ville+Codpost
Cells(Nligne, "H") = Mid(Cells(Nligne, "H"), 1, Len(Cells(Nligne, "H")) - NbL)  'Adresse
 

Pièces jointes

  • sri75 V5.xlsm
    17.3 KB · Affichages: 4
Vote positif 0 Vote négatif
S

sri75

XLDnaute Occasionnel
sylvanu à dit:
Re,
J'ai supprimé la colonne VCARD qui ne servait à rien, et j'ai rajouté à la fin :
VB: 
Adresse = Split(Cells(Nligne, "H"), " ")                                        'Découpage adresse
Cells(Nligne, "J") = Adresse(UBound(Adresse))                                   'Ville
Cells(Nligne, "I") = "'" & Adresse(UBound(Adresse) - 1)                         'CodPost
NbL = Len(Adresse(UBound(Adresse))) + Len(Adresse(UBound(Adresse) - 1)) + 2     'Nbcar Ville+Codpost
Cells(Nligne, "H") = Mid(Cells(Nligne, "H"), 1, Len(Cells(Nligne, "H")) - NbL)  'Adresse
Cliquez pour agrandir...
Bonjour, c'est exactement ce dont j'avais besoin, encore merci pour votre aide précieuse et votre patience.
Très bonne journée
 
Vote positif 0 Vote négatif

Discussions similaires

M
  • Question
XL 2010 Impossible d'exécuter la macro. Importe Excel vers Word.
Réponses
6
Affichages
371
wDog66
wDog66
G
  • Résolu(e)
XL 2016 Mise en forme d'un export de logiciel dans un fichier Excel
2 3
Réponses
30
Affichages
838
Gils92
G
vgendron
  • Question
Power Query [Resolu] Importer plusieurs fichiers excel provenant de dossiers différents sur sharepoint
Réponses
6
Affichages
1 K
Staple1600
Staple1600
P
  • Résolu(e)
XL 2013 creation d'une arborescence
2 3
Réponses
30
Affichages
747
psgm76
P
G
  • Question
Microsoft 365 Import Donnes issu de fichier CSV
2 3
Réponses
40
Affichages
2 K
laurent950
laurent950
edgy63
  • Question
Microsoft 365 Remplir cellules à partir de plusieurs fichiers Excel d'un dossier
2
Réponses
17
Affichages
500
alexga78
A
F
  • Résolu(e)
XL 2021 VBA et Power Query : ecrire des requetes avec variables
2
Réponses
28
Affichages
1 K
Florent74
F
P
  • Résolu(e)
XL 2010 Formule excel synthese arrets
Réponses
2
Affichages
255
pomunho
P
kkamadou
  • Question
importation de donnees dans un fichier excel dans un formulaire
Réponses
3
Affichages
424
kkamadou
kkamadou
J
  • Question
XL 2021 excel - vbs - csv
2
Réponses
28
Affichages
1 K
jerome1980
J

Membres actuellement en ligne

15 membres et 89 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 093
Messages
2 116 139
Membres
112 669
dernier inscrit
Guigui2502