Automatiser la fonction export dans outlook

Version imprimable

24/01/2005, 17h39
sev54

Automatiser la fonction export dans outlook

je dois automatiser la fonction export vers Excell ou Access des mails contenus dans un certain dossier
lorsque je cherche dans l'aide, je ne trouve que la manipulation par l'assistant soit celle que je dois automatisée (fichier --> menu importer --> exporter...)

si quelqu'un a la solution, d'avance merci

sev
26/01/2005, 10h45
sev54

pas possible d'automatiser semble t il

personne n'a su me répondre pour l'instant

chez microsoft, j'ai trouvé un article qui, pour résumer, dit que "on ne peut pas automatiser l'Assistant Importation/Exportation"

le lien pour aller le lire :
http://support.microsoft.com/default.aspx?scid=kb;fr;306067

donc je modifie ma question : quelqu'un saurait il comment aller récupérer les éléments dans Outlook mais depuis Access ?

d'avance merci

Sev

salut sev54

J'ai exactement le meme probleme que toi.
Je veux que mes messages d'outlook soit extrait vers une base de données ou un fichier type excel /access/iou bloc-notes.

J'ai trouvé sur un site :

Code:

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
 
Sub Informations_ContactsOutlook()
'necessite d'activer la reference Microsoft Outlook xx.x Object Library
Dim olApp As New Outlook.Application
Dim Cible As Outlook.ContactItem
Dim dossierContacts As Outlook.MAPIFolder
Dim Cells
'Ouvre l'application excel'
Set oApp = CreateObject("excel.application")
    oApp.Visible = True
' ouvre le bon fichier de mise en page
Set ex = oApp.Workbooks.Open(Path & "C:\Documents and Settings\aurelien\Mes documents\aurelien\" & "outlook.xls")
 
 
Set olApp = New Outlook.Application
Set dossierContacts = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
 
For Each Cible In dossierContacts.Items
'If Cible.LastName = "MichelXLD" Then 'partie droite du champ nom complet
 
Cells(1, 1) = Cible.To 'champ nom complet
Cells(1, 2) = Cible.CC 'champ nom complet
Cells(1, 3) = Cible.Subject 'partie gauche du champ nom complet
 
'End If
Next
End Sub

cela ouvre un fichier excel mais ne colle pas encore les info

voila
je te tiens au courant de mes recherche !!! :wink:

27/01/2005, 08h31
EssaiEncore

personne pour nous aider !!!

Salut,

voilà le code pour écrire dans le fichier excel

j'ai du ajouté un saveas car la feuille se fermait dès la fin du next

c'est bien sur à améliorer mais ça devrait t'aider

Code:

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
Sub Informations_ContactsOutlook()
'necessite d'activer la reference Microsoft Outlook xx.x Object Library
Dim olApp As New Outlook.Application
Dim Cible As Outlook.ContactItem
Dim dossierContacts As Outlook.MAPIFolder
Dim ExcelWorksheet As Object
 
'Dim Cells
'Ouvre l'application excel'
Set oApp = CreateObject("excel.application")
    oApp.Visible = True
' ouvre le bon fichier de mise en page
Set ex = oApp.Workbooks.Open(Path "C:\Documents and Settings\aurelien\Mes documents\aurelien\" & "outlook.xls")
Set ExcelWorksheet = CreateObject("Excel.Sheet")
 
Set olApp = New Outlook.Application
Set dossierContacts = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
 
 
For Each Cible In dossierContacts.Items
 
f = f + 1
 
' ce sont quelques uns des éléments que l'on peut afficher
ExcelWorksheet.Application.Cells(f, 1).Value = Cible.CreationTime
ExcelWorksheet.Application.Cells(f, 2).Value = Cible.FullName
ExcelWorksheet.Application.Cells(f, 3).Value = Cible.Email1Address
 
Next
 
ExcelWorksheet.SaveAs ("C:\Documents and Settings\aurelien\Mes documents\aurelien\" & "outlook.xls")
 
End Sub

par contre, attention si tu as des listes de distribution ça génère une erreur que je n'ai pas encore réussi à corriger

j'espère que ça pourra te servir

voila

Sev

merci cela va m'aider

pour ma part j'ai reussi a "bidouiller" une appli pour que les messages outlook j'enregistre dans un fichier texte

je te le donne au cas ou !!! on ne sais jamais

Merci encore

Code:

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
 
Sub Enregistrements_Messages()
 
Dim objApplication As Outlook.Application
    Dim objNameSpace As Outlook.NameSpace
    Dim objEmails As Outlook.MAPIFolder
    Dim objEmail As Outlook.MailItem
    Dim emailIndex As Integer
 
     'Dim objEmail As String
     Dim objSender As String
     Dim objReceivedTime As String
     Dim objBody As String
     Dim objHTMLBody As String
 
    Dim numfic As Integer
    Dim nomfic As String
 
 
 Set objApplication = CreateObject("Outlook.Application")
    Set objNameSpace = objApplication.GetNamespace("MAPI")
    Set objEmails = objNameSpace.PickFolder
 
 
    For emailIndex = 1 To objEmails.Items.Count
        Set objEmail = objEmails.Items.Item(emailIndex)
 
       'Set objSender = objEmail.SenderName
 
      'MsgBox "Outlook E-Mail Items exported to " & objEmail.To & objEmail.Subject & objEmail.Body & objEmail.ReceivedTime
 
        nomfic = "C:\Documents and Settings\aurelien\Mes documents\" & objEmail.Subject & ".txt"
 
        numfic = FreeFile
 
        Open nomfic For Output As numfic
            'On ecrit la date de reception
                Print #numfic, objEmail.ReceivedTime
                Print #numfic, objEmail.To
                Print #numfic, objEmail.Subject
                Print #numfic, objEmail.Body
 
            Close numfic
 
       ' Set objReceivedTime = objEmail.ReceivedTime
 
       ' Set objSubject = objEmail.Subject
 
       ' Set objBody = objEmail.Body
 
       ' Set objHTMLBody = objEmail.HTMLBody
 
 
    Next
 
 
End Sub

exporter le sujet de mails depuis Outlook vers Access

Merci à tous ceux qui participent à ce site et m'ont ainsi permis par leurs échanges de trouver une solution :)

les experts excuseront le(a) débutant(e) :oops: que je suis mais voici ma procédure qui

- liste les mails
- les enregistre sur le disque dur
- insère dans une base Access les éléments voulus

:!: cette macro a été écrite pour ma société j'ai donc remplacé par des terms génériques entre [] mes variables :!:

Code:

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
 
Sub Export_MailsOutlook()
'la référence Microsoft Outlook 9.0 Object Library est activée
Dim olApp As New Outlook.Application
Dim Cible As Outlook.MailItem
Dim Piece As Attachment
Dim dossierMail As Outlook.MAPIFolder
Dim destFolder
 
'nécessite d'activer la référence Microsoft DAO 3.6 Object Library
Dim dbs As Database
Dim CurrentDb As Database
Dim rs As DAO.Recordset
Dim QD As QueryDef
 
'ouverture d'Access
Set AccessApp = CreateObject("access.application")
AccessApp.OpenCurrentDatabase ("c:\[mondossier]\[mabase].mdb")
Set dbs = AccessApp.CurrentDb
 
Set olApp = New Outlook.Application
Set dossierMail = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("[dossier_source]")
Set destFolder = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("[dossier_destinataire]")
 
For Each Cible In dossierMail.Items
 
    'remplacement des caractères interdits dans les noms de dossier Windows
    Cible = Replace(Cible, "\", "", 1)
    Cible = Replace(Cible, "/", "", 1)
    Cible = Replace(Cible, ":", "", 1)
    Cible = Replace(Cible, "*", "", 1)
    Cible = Replace(Cible, "?", "", 1)
    Cible = Replace(Cible, """", "", 1)
    Cible = Replace(Cible, "<", "", 1)
    Cible = Replace(Cible, ">", "", 1)
    Cible = Replace(Cible, "|", "", 1)
 
    ' on appelle la fonction qui eclate le sujet et retourne les éléments nécessaires pour la base
    ExploseSujet (Cible.Subject)
 
    'on insert les éléments
    dbs.Execute "INSERT INTO [matable] ([champ1], [champ2], [champ3], [champ4], [champ5], [champ6], [champ7], [champ8]) VALUES ('" & [valeur1] & "','" & [valeur2] & "','" & [valeur3] & "','" & [valeur4] & "','" & [valeur5] & "','" & [valeur6] & "','" & [valeur7] & "','" & [valeur8] & "');"
 
    'on crée le chemin et le nom du dossier
    CheminDossier = "F:\" & [valeur1] & "\" & [valeur2] & "\" & [valeur3] & "\" & [valeur4] & "\" & [valeur5] & "\"
 
    Cible.SaveAs CheminDossier & Cible & ".msg", 3   
 
    'on déplace les mails dans un autre dossier "old"
    Cible.Move (destFolder)
 
Next Cible
 
End Sub

j'espère que ça pourra servir à quelqu'un :wink:

Sev