Discussion :

[tAKAmAkA]

Bonjour à tous,

Je souhaite utiliser le tuto de heureux-oli pour recuperer le carnet d'adresse outlook mais ça "debogue" direct avec "Membre sur méthode ou de données introuvable" sur .items (en rouge)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Public Sub ParcourirContact()
Dim oCont As ContactItem
Dim oFold As Folder
Dim nM As Namespace
Dim olApp As Outlook.Application
Set olApp = Outlook.Application
Set nM = olApp.GetNamespace("MAPI")
Set oFold = nM.GetDefaultFolder(olFolderContacts)
For Each oCont In oFold.items
    Debug.Print oCont.LastName
Next oCont
End Sub

Les fonctions et types sont déclarés en tête de module comme indiqué dans le tuto.

Merci de votre attention.

[Maxence HUBICHE]

et si tu remplaçais

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dim oFold As Folder

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Dim oFold As MAPIFolder

?

[tAKAmAkA]

Merci Maxence, c'était ça.

Autres problèmes:

1-sur la partie maj table depuis outlook:
Mon champ "Fonction" (correspondant à ContactItem.Title) est défini en Null interdit et Chaine vide Non autorisée.
Malgré l'utilisation de Nz il y a erreur 3315 "le champ tbl.Fonction ne peu pas être une chaine vide".
La fonction complete:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
43
44
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 tblContact.*, tblContact.Nom, tblContact.EmailC "
sql = sql & " FROM tblContact "
sql = sql & " Where tblContact.Nom = """ & mycont.FullName
sql = sql & """ AND tblContact.[EmailC] = """ & mycont.Email1Address & """;"
 Debug.Print sql
Set db = CurrentDb
Set rs = db.OpenRecordset(sql)
If rs.RecordCount = 0 Then
    Select Case MsgBox("Importer :" & mycont.FullName & vbCrLf & mycont.CompanyName & vbCrLf & mycont.Email1Address & "?", vbYesNoCancel + vbQuestion, "ANAsoft Documage")
        Case vbYes
            rs.AddNew
            rs.Fields(1) = Nz(mycont.FullName, "nc")
            rs.Fields(2) = Nz(mycont.CompanyName, "nc")
            rs.Fields(3) = Nz(mycont.JobTitle, "nc")
            rs.Fields(4) = Nz(mycont.BusinessTelephoneNumber, "")
            rs.Fields(5) = Nz(mycont.MobileTelephoneNumber, " ")
            rs.Fields(6) = Nz(mycont.BusinessFaxNumber, " ")
            rs.Fields(7) = Nz(mycont.Email1Address, " ")
            rs.Update
        Case vbNo
            GoTo sortie:
        Case vbCancel
            GoTo sortie:    'a revoir
    End Select
End If
'**********************************************************************
' Libération des objets
'**********************************************************************
sortie:
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
End Function

2- Sur reponse vbCancel j'aimerai sortir de la procédure appelant la fonction pour arrêter le processus: comment faire?

[Maxence HUBICHE]

1-pb de chaine vie
Je ne vois pas de ContactItem.Title dans ton code
De plus, tu es étonné de recevoir une chaine vide alors que tu dis que tu as mis la propriété du champ à "non" ! Comprends pas !


2-sortie
Ben... tu sors là !

[tAKAmAkA]

pb de chaine vie

En fait c'est c'est JobTitle mais le pb n'est pas là.
Je ne suis pas étonné de recevoir une chaine vide, ni de la réaction d'Access qui me dit qu'il faut une valeur puisque chaine vide n'est pas autorisé.
Je suis étonné que Nz(mycont.JobTitle, "nc") ne me remplace pas la chane vide par "nc".
J'ai modifié en Nz(CStr(mycont.JobTitle); "nc") sans plus de succès.
J'ai fini par bétonner comme ceci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
43
44
45
46
47
48
49
50
51
52
53
54
55
Public Function AccesADB(mycont As ContactItem)
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim sql As String
    Dim strFullName As String, strCompanyName As String, strJobTitle As String
    Dim strBusinessTelephoneNumber As String, strMobileTelephoneNumber As String
    Dim strBusinessFaxNumber As String, strEmail1Adress As String
 
    strFullName = Nz(CStr(mycont.FullName), "nc")
    strCompanyName = Nz(CStr(mycont.CompanyName), "nc")
    strJobTitle = Nz(CStr(mycont.JobTitle), "nc")
    strBusinessTelephoneNumber = Nz(CStr(mycont.BusinessTelephoneNumber), " ")
    strMobileTelephoneNumber = Nz(CStr(mycont.MobileTelephoneNumber), " ")
    strBusinessFaxNumber = Nz(CStr(mycont.BusinessFaxNumber), " ")
    strEmail1Adress = Nz(CStr(mycont.Email1Address), " ")
    sql = "SELECT tblContact.*, tblContact.Nom, tblContact.EmailC "
    sql = sql & " FROM tblContact "
    sql = sql & " Where tblContact.Nom = """ & mycont.FullName
    sql = sql & """ AND tblContact.[EmailC] = """ & mycont.Email1Address & """;"
Set db = CurrentDb
Set rs = db.OpenRecordset(sql)
If rs.RecordCount = 0 Then
    'nb:La police de la msgbox n'est pas à "pas constant", utiliser plutôt un formulaire.
    Select Case MsgBox("Importation de : " & mycont.FullName & vbCrLf & _
                       "Société             : " & mycont.CompanyName & vbCrLf & _
                       "Fonction           : " & mycont.strJobTitle & vbCrLf & _
                       "Tel profess.      : " & strBusinessTelephoneNumber & vbCrLf & _
                       "Mobile               : " & strMobileTelephoneNumber & vbCrLf & _
                       "Fax profess.     : " & strBusinessFaxNumber & vbCrLf & _
                       "Adresses Email  : " & strEmail1Adress & vbCrLf & vbCrLf & _
                       "Validez cette importation", vbYesNoCancel + vbQuestion, "xxx")
        Case vbYes
            If Len(strCompanyName) = 0 Then strCompanyName = InputBox("Renseignez la Société : ", "Importation de " & strFullName, "nc")
            If Len(strJobTitle) = 0 Then strJobTitle= InputBox("Renseignez la Fonction : ", "Importation de " & strFullName, "nc")
            rs.AddNew
            rs.Fields(1) = strFullName
            rs.Fields(2) = strCompanyName
            rs.Fields(3) = strJobTitle
            rs.Fields(4) = strBusinessTelephoneNumber
            rs.Fields(5) = strMobileTelephoneNumber
            rs.Fields(6) = strBusinessFaxNumber
            rs.Fields(7) = strEmail1Adress
            rs.Update
            retourAccesADB = True
        Case vbNo
            retourAccesADB = True
        Case vbCancel
            retourAccesADB = False
    End Select
            Debug.Print "retourAccesADB2 " & retourAccesADB
End If
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing

2-sortie
Ben... tu sors là !

Je ne sort que de la fonction, pas de la boucle. J'ai utilisé une variable "retourAccesADB" que je teste dans le sub appelant:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Private Sub cmdImportOutlook_Click()
    Dim oCont As ContactItem
    Dim oFold As MAPIFolder
    Dim nM As Namespace
    Dim olApp As Outlook.Application
    Dim i As Integer
    Dim j As Integer
    retourAccesADB = True
    j = 1
    ' Affectation des objets
    Set olApp = Outlook.Application
    Set nM = olApp.GetNamespace("MAPI")
    Set oFold = nM.GetDefaultFolder(olFolderContacts)
    i = oFold.items.Count
    ' Boucle pour parcourir les contacts locaux
For j = 1 To i
    If retourAccesADB = True Then
        AccesADB (oFold.items(j))
    Else
        Exit Sub
    End If
Next j
End Sub

avec en formOpen

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Private Sub Form_Open(Cancel As Integer)
    retourAccesADB = True   'Déclarée en tête de module
End Sub

Et ça roule.
C'est résolu mais la question du Nz inefficace me chagrine...

[Maxence HUBICHE]

Je t'invite à suivre les règles que nous appliquons sur ce site : UNE SEULE QUESTION par enfilade.
Merci

1-Pb de chaine vide

NZ, c'est NullVersZero
Donc, cela ne traite en aucun cas une chaine vide.
La fonction traite seulement le NULL
Tu peux faire (remplace les xxx par les éléments qui t'intéressent) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
iif(nz(xxx,"")="","nc",xxxx)

2- Pb de sortie
Tu as une fonction !
Une fonction renvoie un résultat !
Fais que ta fonction renvoie un résultat

Tu pourrais pas exemple commencer par modifier la signature de ta fonction de

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Public Function AccesADB(mycont As ContactItem)

vers

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Public Function AccesADB(mycont As ContactItem) as Boolean

Pour annoncer qu'elle va renvoyer du boolean

Ensuite, déclarer au démarrage que

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
AccesADB=true

Et si tu es dans les case vbNo et vbCancel, tu fais un

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
AccesADB=False

Après, dans ta boucle, tu n'as plus qu'à tester le résultat, savoir si ta fonction renvoie VRAI ou FAUX

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
For j = 1 To i
    If AccesADB (oFold.items(j)) Then
        'rien à faire
    Else
        Exit For
    End If
Next j

[tAKAmAkA]

C'est parfait, merci.