none
Outlook vers access : dates farfelues RRS feed

  • Question

  • 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
    • Type modifié Aurel Bera mercredi 30 janvier 2013 13:24 Discussion
    • Type modifié Aurel Bera mercredi 30 janvier 2013 14:27 Question
    jeudi 24 janvier 2013 11:34

Réponses

  • Bonjour,

    Désolé de ne pas être revenu avant...

    apres quelques recherches google, il s'avére qu'outook envoie la date 01/01/4501
    par défaut si aucune date n'est renseignée dans la fiche.

    je contourne ca  pour l'instant avec un simple :

    If mycont.Birthday = #1/1/4501# Then
            rs.Fields("Birthday") = Null
    End If
    Merci

     

    • Marqué comme réponse Aurel Bera mercredi 30 janvier 2013 14:27
    mercredi 30 janvier 2013 14:21

Toutes les réponses