Discussion :

[nachise]

Bonsoir,
À nouveau je viens vers vous pour savoir s'il est possible de générer un groupe de contacts Outlook suite à une requête dans un programme access et que cela se fasse automatiquement pour entrer dans Outlook et ensuite envoyer un message à tous les membres trouvés....
Un gros merci à l'avance!

[Robert1957]

Bonjour nachise,
Je ne sais pas pour créer un groupe dans Outlook à partir d'Access. Mais pour ce qui est d'envoyer un mail à partir d'une requête tu peux fonctionner 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
   'récupérer les adresses 
    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    Dim strSQL As String, strDest As String
    Set db = CurrentDb
    strSQL = "Ta requête"
    Set rst = db.OpenRecordset(strSQL)
    rst.MoveFirst
    strDest = ""
    While rst.EOF = False
        If strDest = "" Then
            strDest = rst("AdresseEmail")
 
        Else
            strDest = strDest & ";" & rst("AdresseEmail")
 
        End If
        rst.MoveNext
    Wend
    rst.close
    Set rst = Nothing
    Set db = Nothing

Puis:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
    ' Envoyer un mail.
    Dim outobj As Outlook.Application
    Dim outappt As Outlook.MailItem
    Set outobj = CreateObject("outlook.application")
    Set outappt = outobj.CreateItem(olMailItem)
    With outappt
        .To = strDest 'Ta liste de destinataire
        .Body = "Ton message"
        .Subject = "Le titre du message"
        .Importance = olImportanceHigh 'Importance du message
        .Display 'Ouvre le message Outlook
    End With
   ' Libérez la variable objet Outlook.
   Set outobj = Nothing

J'espère que ça peut t'aider.
Bonne journée

[nachise]

Merci.
Je vais essayer cela et je vous en redonne des nouvelles.
Bonne fin de journée!

[User]

Bonjour,

En complément, pour créer un nouveau contact dans un dossier Outlook tu peux regarder ceci.

A adapter à ton cas

A+

[User]

Salut,

Pour être plus clair, voici un exemple de fonction qui peut le faire :

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
56
57
58
59
60
61
62
Public Function EnvoiMail(Objet, Message)
'Ajouter les références suivantes :
'Microsoft Outlook 12.0
 
Dim oMail As Outlook.MailItem
Dim olkapp As Outlook.Application
Dim olknamespace As Object
Dim objOLfolder As Outlook.MAPIFolder
Dim objMnfolder As Outlook.MAPIFolder
Dim itms As Outlook.Items
Dim olkItem As Outlook.ContactItem
 
Dim dest As String
 
    If Not IsOutLookRunning() Then
          Dim oShell As Object
          Set oShell = CreateObject("WScript.Shell")
          oShell.Run "outlook"
          Set oShell = Nothing
    End If
 
     'ouverture de l'object outlook
 
    Set olkapp = CreateObject("Outlook.application")
    Set olknamespace = olkapp.GetNamespace("MAPI")
 
    Set olMnfolder = olknamespace.Folders("Fichier de données Outlook")
    Set objOLfolder = olMnfolder.Folders("Contacts")
 
    Set itms = objOLfolder.Items
 
    For i = 1 To itms.Count
       Set olkItem = itms(i)
       dest = dest & olkItem.Email1Address & ";"
    Next i
 
   Set oMail = olkapp.CreateItem(olMailItem)
 
   With oMail
    .To = dest
    .Subject = Objet
    .Body = Message
    '.Save
    .Display
    End With
 
EnvoiMail = oMail.EntryID
 
Set oMail = Nothing
'Ferme Outlook
'olkapp.Quit
Set olkItem = Nothing
Set itms = Nothing
 
'fermeture et libération des objets
Set objOLfolder = Nothing
Set objMnfolder = Nothing
 
Set olknamespace = Nothing
Set olkapp = Nothing
 
End Function

Avec une fonction en plus pour tester si Outlook tourne:

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
Public Function IsOutLookRunning() As Boolean
On Error Resume Next
 
    'Get a reference to Word if it's open
    Set objOutLook = GetObject(, "OutLook.Application")
 
    'If Word isn't open, create an instance of it
    If (Err <> 0) Then
        IsOutLookRunning = False
    Else
        IsOutLookRunning = True
    End If
 
Set objOutLook = Nothing
 
End Function

A+