Importer csv en VBA

Le
HB
Bonjour,

Un grand nombre de fichiers CSV qui contiennent des exportations de
contacts (venus d'ailleurs) sont rangés de façon logique dans des
répertoires.

J'arrive à reproduire par macro l'arborescence
dans les contacts d'outlook
et à chaque csv je fais correspondre un dossier
dans les dossiers crées dans les contacts ;o)


Il me reste à automatiser l'importation du contenu des CSV

Et là je sèche et comme l'enregistrement de macros n'existe pas je
n'arrive pas à savoir si c'est possible ou pas

J'aimerais bien un truc du style

set MACHIN = Outlook.ImportationDeContacts
MACHIN.Source.Shemin = "C:BiduleTrucchouette.csv"
MACHIN.Source.Type = "CSV"
MACHIN.Sible = UndossierDansLesContacts
MACHIN.Champs.NomComplet = "Nom à afficher"

etc
jusqu'à

MACHIN.ExecuteEnfin

;o)

on peut rêver, non ?

Toute piste sera bienvenue,

Cordialement,
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
ThierryP
Le #26419039
Bonjour,
J'ai eu le même genre de problème récemment, et après p as mal de recherches.... j'ai fini par commettre ceci :
'----------------------------------------------
Sub ExcelVersOutlookContacts()
Dim applOutlook As Outlook.Application
Dim nsOutlook As Outlook.Namespace
Dim ciOutlook As Outlook.ContactItem
DerLig = Sheets("Feuil1").Cells(Rows.Count, "A").End(xlUp).Row
Set applOutlook = New Outlook.Application
Set nsOutlook = applOutlook.GetNamespace("MAPI")
For i = 2 To DerLig 'Mon fichier commence en ligne 2
Set ciOutlook = applOutlook.CreateItem(olContactItem)
ciOutlook.Display
With ciOutlook
.FirstName = Sheets("Feuil1").Cells(i, 1)
.LastName = Sheets("Feuil1").Cells(i, 2)
.Email1Address = Sheets("Feuil1").Cells(i, 3)
.CompanyName = Sheets("Feuil1").Cells(i, 4) ' Tu peux ajouter aut ant d'infos que tu veux
End With
ciOutlook.Close olSave
Next i
applOutlook.Quit
Set applOutlook = Nothing
Set nsOutlook = Nothing
Set ciOutlook = Nothing
Set delFolder = Nothing
Set delItems = Nothing
End Sub
'---------------------------------------
et qui fonctionne !
Cordialement,
ThierryP
Le dimanche 27 novembre 2016 01:13:44 UTC+1, HB a écrit :
Bonjour,
ThierryP
Le #26419041
Petit oubli : il faut ajouter la référence Microsoft Outlook xx L ibrary
Le mardi 29 novembre 2016 11:14:43 UTC+1, ThierryP a écrit :
Bonjour,
J'ai eu le même genre de problème récemment, et après pas mal de recherches.... j'ai fini par commettre ceci :
'----------------------------------------------
Sub ExcelVersOutlookContacts()
Dim applOutlook As Outlook.Application
Dim nsOutlook As Outlook.Namespace
Dim ciOutlook As Outlook.ContactItem
DerLig = Sheets("Feuil1").Cells(Rows.Count, "A").End(xlUp).Row
Set applOutlook = New Outlook.Application
Set nsOutlook = applOutlook.GetNamespace("MAPI")
For i = 2 To DerLig 'Mon fichier commence en ligne 2
Set ciOutlook = applOutlook.CreateItem(olContactItem)
ciOutlook.Display
With ciOutlook
.FirstName = Sheets("Feuil1").Cells(i, 1)
.LastName = Sheets("Feuil1").Cells(i, 2)
.Email1Address = Sheets("Feuil1").Cells(i, 3)
.CompanyName = Sheets("Feuil1").Cells(i, 4) ' Tu peux ajouter a utant d'infos que tu veux
End With
ciOutlook.Close olSave
Next i
applOutlook.Quit
Set applOutlook = Nothing
Set nsOutlook = Nothing
Set ciOutlook = Nothing
Set delFolder = Nothing
Set delItems = Nothing
End Sub
'---------------------------------------
et qui fonctionne !
Cordialement,
ThierryP
Le dimanche 27 novembre 2016 01:13:44 UTC+1, HB a écrit :
Bonjour,
ThierryP
Le #26419040
Et, vu le VBS que tu m's envoyé récemment, je ne t'ai pas fait l' injure de gérer la boucle de traitement des CSV... ;o))))
ThierryP
Le mardi 29 novembre 2016 11:23:09 UTC+1, ThierryP a écrit :
Petit oubli : il faut ajouter la référence Microsoft Outlook xx Library
Le mardi 29 novembre 2016 11:14:43 UTC+1, ThierryP a écrit :
Bonjour,
J'ai eu le même genre de problème récemment, et aprà ¨s pas mal de recherches.... j'ai fini par commettre ceci :
'----------------------------------------------
Sub ExcelVersOutlookContacts()
Dim applOutlook As Outlook.Application
Dim nsOutlook As Outlook.Namespace
Dim ciOutlook As Outlook.ContactItem
DerLig = Sheets("Feuil1").Cells(Rows.Count, "A").End(xlUp).Row
Set applOutlook = New Outlook.Application
Set nsOutlook = applOutlook.GetNamespace("MAPI")
For i = 2 To DerLig 'Mon fichier commence en ligne 2
Set ciOutlook = applOutlook.CreateItem(olContactItem)
ciOutlook.Display
With ciOutlook
.FirstName = Sheets("Feuil1").Cells(i, 1)
.LastName = Sheets("Feuil1").Cells(i, 2)
.Email1Address = Sheets("Feuil1").Cells(i, 3)
.CompanyName = Sheets("Feuil1").Cells(i, 4) ' Tu peux ajouter autant d'infos que tu veux
End With
ciOutlook.Close olSave
Next i
applOutlook.Quit
Set applOutlook = Nothing
Set nsOutlook = Nothing
Set ciOutlook = Nothing
Set delFolder = Nothing
Set delItems = Nothing
End Sub
'---------------------------------------
et qui fonctionne !
Cordialement,
ThierryP
Le dimanche 27 novembre 2016 01:13:44 UTC+1, HB a écrit :
> Bonjour,
Publicité
Poster une réponse
Anonyme