Hello tout le monde,
j'exporte mes contacts
en vba vers une bdd access 2010.
Public Sub ParcourirContact()
'*************************************************************************
' Routine qui va parcourir les enregistrements présents dans le répertoire
' contacts et copier les enregistrements manquants dans la base de données
' Macro crée pour article DVP par Olivier Lebeau
'*************************************************************************
Dim oCont As ContactItem
Dim oFold As Folder
Dim nM As NameSpace
Dim olApp As Outlook.Application
Dim i As Integer
Dim j As Integer
j = 1
' Affectation des objets
Set olApp = CreateObject("Outlook.Application")
Set nM = olApp.GetNamespace("MAPI")
Set oFold = nM.Folders("monmail@monmail.fr").Folders("CONTACTS001")
i = oFold.Items.Count
' Boucle pour parcourir les contacts locaux
For j = 1 To i
' Appel à la fonction AccesADB avec comme paramètre le contactItem
AccesADB (oFold.Items(j))
Next j
End Sub
Public Function AccesADB(mycont As ContactItem)
'**************************************************************************
' Fonction appelée pour envoyer vers la base de données les nouveaux
' contacts
' Fonction écrite pour article DVP par Olivier Lebeau
'**************************************************************************
'On Error Resume Next
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim sql As String
sql = "SELECT tb_Contacts.* "
sql = sql & " FROM tb_Contacts "
sql = sql & " Where tb_Contacts.EntryID = """ & mycont.EntryID & """;"
Debug.Print sql
' Vous devez spécifier le chemin complet de votre base de données
Set db = OpenDatabase("E:\bdd\contacts_direction_2012.accdb")
Set rs = db.OpenRecordset(sql)
Debug.Print rs.RecordCount
'**********************************************************************
' La liste des champs traités peut être augmentée en fonction de vos
' besoins. Par facilité, je n'ai volontairement mis que 3 champs
' Si vous rencontrez des problèmes avec les lignes Fields("xxxxx")
' je vous conseille d'utiliser l'index du champ Fields(2)
'**********************************************************************
If rs.RecordCount = 0 Then
rs.AddNew
rs.Fields("Account") = Nz(mycont.Account, " ")
rs.Fields("Anniversary") = Nz(mycont.Anniversary, " ")
rs.Fields("AssistantName") = Nz(mycont.AssistantName, " ")
rs.Fields("AssistantTelephoneNumber") = Nz(mycont.AssistantTelephoneNumber, " ")
rs.Fields("BillingInformation") = Nz(mycont.BillingInformation, " ")
rs.Fields("Birthday") = Nz(mycont.Birthday, " ")
rs.Fields("Body") = Nz(mycont.Body, " ")
rs.Fields("Business2TelephoneNumber") = Nz(mycont.Business2TelephoneNumber, " ")
rs.Fields("BusinessAddress") = Nz(mycont.BusinessAddress, " ")
rs.Fields("BusinessAddressCity") = Nz(mycont.BusinessAddressCity, " ")
rs.Fields("BusinessAddressCountry") = Nz(mycont.BusinessAddressCountry, " ")
rs.Fields("BusinessAddressPostalCode") = Nz(mycont.BusinessAddressPostalCode, " ")
rs.Fields("BusinessAddressPostOfficeBox") = Nz(mycont.BusinessAddressPostOfficeBox, " ")
rs.Fields("BusinessAddressState") = Nz(mycont.BusinessAddressState, " ")
rs.Fields("BusinessAddressStreet") = Nz(mycont.BusinessAddressStreet, " ")
rs.Fields("BusinessFaxNumber") = Nz(mycont.BusinessFaxNumber, " ")
rs.Fields("BusinessHomePage") = Nz(mycont.BusinessHomePage, " ")
rs.Fields("BusinessTelephoneNumber") = Nz(mycont.BusinessTelephoneNumber, " ")
rs.Fields("CallbackTelephoneNumber") = Nz(mycont.CallbackTelephoneNumber, " ")
rs.Fields("CarTelephoneNumber") = Nz(mycont.CarTelephoneNumber, " ")
rs.Fields("Categories") = Nz(mycont.Categories, " ")
rs.Fields("Children") = Nz(mycont.Children, " ")
rs.Fields("Companies") = Nz(mycont.Companies, " ")
rs.Fields("CompanyMainTelephoneNumber") = Nz(mycont.CompanyMainTelephoneNumber, " ")
rs.Fields("CompanyName") = Nz(mycont.CompanyName, " ")
rs.Fields("CustomerID") = Nz(mycont.CustomerID, " ")
rs.Fields("Department") = Nz(mycont.Department, " ")
rs.Fields("Email1Address") = Nz(mycont.Email1Address, " ")
rs.Fields("Email1AddressType") = Nz(mycont.Email1AddressType, " ")
rs.Fields("Email2Address") = Nz(mycont.Email2Address, " ")
rs.Fields("Email2AddressType") = Nz(mycont.Email2AddressType, " ")
rs.Fields("Email2DisplayName") = Nz(mycont.Email2DisplayName, " ")
rs.Fields("Email3Address") = Nz(mycont.Email3Address, " ")
rs.Fields("Email3AddressType") = Nz(mycont.Email3AddressType, " ")
rs.Fields("Email3DisplayName") = Nz(mycont.Email3DisplayName, " ")
rs.Fields("EntryID") = Nz(mycont.EntryID, " ")
rs.Fields("FirstName") = Nz(mycont.FirstName, " ")
rs.Fields("FTPSite") = Nz(mycont.FTPSite, " ")
rs.Fields("FullName") = Nz(mycont.FullName, " ")
rs.Fields("Gender") = Nz(mycont.Gender, " ")
rs.Fields("GovernmentIDNumber") = Nz(mycont.GovernmentIDNumber, " ")
rs.Fields("Hobby") = Nz(mycont.Hobby, " ")
rs.Fields("Home2TelephoneNumber") = Nz(mycont.Home2TelephoneNumber, " ")
rs.Fields("HomeAddress") = Nz(mycont.HomeAddress, " ")
rs.Fields("HomeAddressCity") = Nz(mycont.HomeAddressCity, " ")
rs.Fields("HomeAddressCountry") = Nz(mycont.HomeAddressCountry, " ")
rs.Fields("HomeAddressPostalCode") = Nz(mycont.HomeAddressPostalCode, " ")
rs.Fields("HomeAddressPostOfficeBox") = Nz(mycont.HomeAddressPostOfficeBox, " ")
rs.Fields("HomeAddressState") = Nz(mycont.HomeAddressState, " ")
rs.Fields("HomeAddressStreet") = Nz(mycont.HomeAddressStreet, " ")
rs.Fields("HomeFaxNumber") = Nz(mycont.HomeFaxNumber, " ")
rs.Fields("IMAddress") = Nz(mycont.IMAddress, " ")
rs.Fields("Importance") = Nz(mycont.Importance, " ")
rs.Fields("Initials") = Nz(mycont.Initials, " ")
rs.Fields("InternetFreeBusyAddress") = Nz(mycont.InternetFreeBusyAddress, " ")
rs.Fields("ISDNNumber") = Nz(mycont.ISDNNumber, " ")
rs.Fields("JobTitle") = Nz(mycont.JobTitle, " ")
rs.Fields("Language") = Nz(mycont.Language, " ")
rs.Fields("LastModificationTime") = Nz(mycont.LastModificationTime, " ")
rs.Fields("LastName") = Nz(mycont.LastName, " ")
rs.Fields("MailingAddress") = Nz(mycont.MailingAddress, " ")
rs.Fields("MailingAddressCity") = Nz(mycont.MailingAddressCity, " ")
rs.Fields("MailingAddressCountry") = Nz(mycont.MailingAddressCountry, " ")
rs.Fields("MailingAddressPostalCode") = Nz(mycont.MailingAddressPostalCode, " ")
rs.Fields("MailingAddressPostOfficeBox") = Nz(mycont.MailingAddressPostOfficeBox, " ")
rs.Fields("MailingAddressState") = Nz(mycont.MailingAddressState, " ")
rs.Fields("MailingAddressStreet") = Nz(mycont.MailingAddressStreet, " ")
rs.Fields("ManagerName") = Nz(mycont.ManagerName, " ")
rs.Fields("MiddleName") = Nz(mycont.MiddleName, " ")
rs.Fields("Mileage") = Nz(mycont.Mileage, " ")
rs.Fields("MobileTelephoneNumber") = Nz(mycont.MobileTelephoneNumber, " ")
rs.Fields("NetMeetingAlias") = Nz(mycont.NetMeetingAlias, " ")
rs.Fields("NetMeetingServer") = Nz(mycont.NetMeetingServer, " ")
rs.Fields("NickName") = Nz(mycont.NickName, " ")
rs.Fields("OfficeLocation") = Nz(mycont.OfficeLocation, " ")
rs.Fields("OrganizationalIDNumber") = Nz(mycont.OrganizationalIDNumber, " ")
rs.Fields("OtherAddress") = Nz(mycont.OtherAddress, " ")
rs.Fields("OtherAddressCity") = Nz(mycont.OtherAddressCity, " ")
rs.Fields("OtherAddressCountry") = Nz(mycont.OtherAddressCountry, " ")
rs.Fields("OtherAddressPostalCode") = Nz(mycont.OtherAddressPostalCode, " ")
rs.Fields("OtherAddressPostOfficeBox") = Nz(mycont.OtherAddressPostOfficeBox, " ")
rs.Fields("OtherAddressState") = Nz(mycont.OtherAddressState, " ")
rs.Fields("OtherAddressStreet") = Nz(mycont.OtherAddressStreet, " ")
rs.Fields("OtherFaxNumber") = Nz(mycont.OtherFaxNumber, " ")
rs.Fields("OtherTelephoneNumber") = Nz(mycont.OtherTelephoneNumber, " ")
rs.Fields("PagerNumber") = Nz(mycont.PagerNumber, " ")
rs.Fields("PersonalHomePage") = Nz(mycont.PersonalHomePage, " ")
rs.Fields("PrimaryTelephoneNumber") = Nz(mycont.PrimaryTelephoneNumber, " ")
rs.Fields("Profession") = Nz(mycont.Profession, " ")
rs.Fields("RadioTelephoneNumber") = Nz(mycont.RadioTelephoneNumber, " ")
rs.Fields("ReferredBy") = Nz(mycont.ReferredBy, " ")
rs.Fields("Spouse") = Nz(mycont.Spouse, " ")
rs.Fields("Suffix") = Nz(mycont.Suffix, " ")
rs.Fields("TelexNumber") = Nz(mycont.TelexNumber, " ")
rs.Fields("Title") = Nz(mycont.Title, " ")
rs.Fields("TTYTDDTelephoneNumber") = Nz(mycont.TTYTDDTelephoneNumber, " ")
rs.Fields("User1") = Nz(mycont.User1, " ")
rs.Fields("User2") = Nz(mycont.User2, " ")
rs.Fields("User3") = Nz(mycont.User3, " ")
rs.Fields("User4") = Nz(mycont.User4, " ")
rs.Fields("WebPage") = Nz(mycont.WebPage, " ")
rs.Fields("YomiCompanyName") = Nz(mycont.YomiCompanyName, " ")
rs.Fields("YomiFirstName") = Nz(mycont.YomiFirstName, " ")
rs.Fields("YomiLastName") = Nz(mycont.YomiLastName, " ")
'rs.Fields("") = Nz(mycont., " ")
rs.Update
End If
'**********************************************************************
' Libération des objets
'**********************************************************************
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
End Function
Aucuns des contacts n'a de dates anniversaire ou de mariage...
Lorsque que je fais l'export vers access, il m'ajoute la date 01/01/4501..
dans access mes champs birthday & anniversary sont au format date, pas de valeurs
par default, null autorisé...
D'où cela peut venir ?
Merci
d'avance
seb
