ATOUTFOX
COMMUNAUTÉ FRANCOPHONE DES PROFESSIONNELS FOXPRO
Visual FoxPro : le développement durable

Fonctions utiles pour automatiser Microsoft Outlook   


L'auteur

Mike Gagnon
Canada Canada
Membre Simple
# 0000000025
enregistré le 14/10/2004

Gagnon Mike
Pointe Cla H9R 3K8
de la société Carver Technologies Inc.
Fiche personnelle

Note des membres
0/20
1 vote

Contributions > 09 - Automation > Outlook

Fonctions utiles pour automatiser Microsoft Outlook
# 0000000083
ajouté le 20/11/2004 14:06:02 et modifié le 18/06/2009
consulté 21652 fois
Niveau initié

Version(s) Foxpro :
VFP 7.0
Description
Quelques fonctions utiles pour Outlook.
Code source :
&&#DEFINE de base

#DEFINE olFolderCalendar 9
#DEFINE olFolderContacts 10
#DEFINE olFolderDeletedItems 3
#DEFINE olFolderInBox 6
#DEFINE olFolderJournal 11
#DEFINE olFolderNotes 12
#DEFINE olFolderOutBox 4
#DEFINE olFolderSentMail 5
#DEFINE olFolderTask 13
#DEFINE olBusy 2
#DEFINE True .T.
#DEFINE False .F.
#DEFINE olPrivate 2
#DEFINE MAILITEM 0
#DEFINE IMPORTANCELOW 0
#DEFINE IMPORTANCENORMAL 1
#DEFINE IMPORTANCEHIGH 2

&&Ouvir le calendrier Outlook

LOCAL oOutlook,oNameSpace,oDefaultFolder
oOutlook = CREATEOBJECT('outlook.application')
oNameSpace = oOutlook.getnamespace('MAPI')
oDefaultFolder=oNameSpace.GetDefaultFolder(olFolderCalendar) &&Calendar
oDefaultFolder.display()

&& Ouvrir les contacts d'Outlook

LOCAL oOutlook,oNameSpace,oDefaultFolder
oOutlook = CREATEOBJECT('outlook.application')
oNameSpace = oOutlook.getnamespace('MAPI')
oDefaultFolder=oNameSpace.GetDefaultFolder(olFolderContacts) &&Contact
oDefaultFolder.display()

&& Utiliser la fonction recherche

oOutlook=CREATEOBJECT('outlook.application')
oNameSpace=oOutlook.getNameSpace('mapi')
oDefaultFolder=oNameSpace.getdefaultfolder(10)
oDefaultFolder.items
oItem=odefaultFolder.Items.Find('[BalanceDue]=500')
oItem.display()


&& Aller chercher le nom et l'addresse courriel de tout les contacts

CREATE CURSOR myCursor (Name c(40),email c(50))
LOCAL oOutlook,oNameSpace,oDefaultFolder
oOutlook = CREATEOBJECT('outlook.application')
oNameSpace = oOutlook.getnamespace('MAPI')
oDefaultFolder=oNameSpace.GetDefaultFolder(olFolderContacts)
oItems = oDefaultFolder.items
FOR EACH oItem IN oItems
 INSERT INTO myCursor (name,email) VALUES (oItem.fullname,oItem.email1address)
ENDFOR
SELECT myCursor
BROWSE

&& Ajouter un nouveau champs de les contacts d'outlook

LOCAL oOutlook,oNameSpace,oDefaultFolder
oOutlook = CREATEOBJECT('outlook.application')
oNameSpace = oOutlook.getnamespace('MAPI')
oDefaultFolder=oNameSpace.GetDefaultFolder(10)
loNewContact = oDefaultfolder.Items.Add()
loNewContact.Fullname = 'Mike Gagnon'
loNewContact.UserProperties.Add('Amount', 14)
loNewContact.UserProperties('Amount').Value = 100.00
loNewContact.save()
MESSAGEBOX(TRANSFORM(loNewContact.UserProperties('Amount').Value))
loNewContact.display

&& Vérifier les messages non-lus

Local oOutlookObject,olNameSpace
#Define olFolderInBox 6
oOutlookObject = Createobject('Outlook.Application')
olNameSpace = oOutlookObject.GetNameSpace('MAPI')
oItems= olNameSpace.GetDefaultFolder(olFolderInBox).Items
For Each loItem In oItems
    If loItem.unRead
       **Do something here
        loItem.unRead = .F. && Mark it as read
    Endif
Next


&& Trouver tout les rendez-vous d'outlook

CREATE CURSOR myCursor (start T,end T,body c(250))
LOCAL oOutlook,oNameSpace,oDefaultFolder
oOutlook = CREATEOBJECT('outlook.application')
oNameSpace = oOutlook.getnamespace('MAPI')
oDefaultFolder=oNameSpace.GetDefaultFolder(olFolderCalendar)
oItems = oDefaultFolder.items
FOR EACH oItem IN oItems
 INSERT INTO myCursor (start,end,body) VALUES (oItem.start,oItem.end,oItem.body)
ENDFOR
SELECT myCursor
BROWSE

&& Supprimmer un rendez-vous

#DEFINE olFolderCalendar 9
LOCAL oNameSpace, oDefaultFolder,oItems
    oOutlook = CreateObject("Outlook.Application")
oNameSpace = oOutlook.GetNameSpace("MAPI")
oDefaultFolder = oNameSpace.GetdefaultFolder(olFolderCalendar)
FOR EACH oItem IN oDefaultFolder.items
  IF oItem.Subject = 'All day meeting'
    lDelete = oItem.Delete
  ENDIF
ENDFOR

&& Ajouter un rendez-vous dans le calendrier Outlook
&& Ceci vous donne un rendez-vous aujourd'hui, dans deux heures, pour une durée d'une heure, avec &&un rappel de 20 minutes

Local oOutlook,oNameSpace
oOutlook = Createobject('outlook.application')
oNameSpace = oOutlook.getnamespace('MAPI')
loItem= oOutlook.createitem(1)
With loItem
 .Subject ="Réunion chez Microsoft"
 .Location ="Montréal"
 .Start=DATETIME()+2*3600
 .End = DATETIME()+3*3600
 .ReminderSet =.T.
 .ReminderMinutesBeforeStart =20
 .Save
Endwith



&& Envoyer un simple courriel

oOutLookObject = CreateObject('Outlook.Application')
oEmailItem = oOutLookObject.CreateItem(MAILITEM)
WITH oEmailItem
   .Recipients.Add('moe@3stooges.com') && uses the Recipients collection
   .Subject = 'Automation sample'
   .Importance = IMPORTANCENORMAL
   .Body = 'This is easy!'
   .Send
ENDWITH
RELEASE oEmailItem
RELEASE oOutLookObject


&& Envoyer un courriel avec attachement.
oOutLookObject = CreateObject('Outlook.Application')
oEmailItem = oOutLookObject.CreateItem(MAILITEM)

WITH oEmailItem
   .Recipients.Add('moe@3stooges.com') && uses the Recipients collection
   .Subject = 'Automation sample'
   .Importance = IMPORTANCENORMAL
   .Body = 'This is easy!'
   .Attachments.Add('c:\mydir\sample.txt') && Note that the fully qualified path and file is required.
   .Send
ENDWITH

RELEASE oEmailItem
RELEASE oOutLookObject

&& Copier tous les attachements de tout les courriels

Local lcFilename,lcPath
lcPath='c:\savedattachments\'
If  !Directory('c:\savedAttachments')
    Md 'c:\savedAttachments' && Create the directory if it doesn't exist.
Endif
oOutLookObject = Createobject('Outlook.Application')
olNameSpace = oOutLookObject.GetNameSpace('MAPI')
myAtts=olNameSpace.GetDefaultFolder(olFolderInbox).Items
For Each loItem In myAtts
    If loItem.attachments.Count >0 && Make sure there is an actual attachment.
        For i = 1 To loItem.attachments.Count
            lcFilename=''
            lcFilename = loItem.attachments.Item(i).filename
            lcFilename = Alltrim(lcPath)+lcFilename
            loItem.attachments.Item(i).SaveAsFile(lcFilename)
           *loItem.Delete() && The option to delete the message once the attachment has been saved.
        Next
    Endif
Next
&& Changer l'information d'un contact.

LOCAL oOutlook,oNameSpace,oDefaultFolder,oItems
oOutlook = CREATEOBJECT('outlook.application')
oNameSpace = oOutlook.GetNameSpace('mapi')
oDefaultFolder = oNameSpace.GetDefaultfolder(olFolderContacts)
oItems=oDefaultFolder.items
FOR EACH loItem IN oItems
   IF loItem.FULLNAME = 'Mis'
      loItem.Email1Address = 'mis@suntel.ca'
      loItem.Save()
   ENDIF
ENDFOR

&& Ajouter un dossier.
Local oOutlook,oNameSpace,oNewFolder
oOutlook=CREATEOBJECT('outlook.application')
oNameSpace=oOutlook.GetNamespace('mapi')
oNewFolder=oNameSpace.Folders(2).Folders.Add('myNewFolder')  && This will create a folder in the Personal folders' directory of Outlook.

&& Comment trouver le nom des sous-dossiers dans le Inbox

CODE
#DEFINE olFolderInBox 6
Local oOutlook,oNameSpace,oDefaultFolder
oOutlook=CREATEOBJECT('outlook.application')
oNameSpace=oOutlook.GetNamespace('mapi')
oDefaultFolder =oNameSpace.Getdefaultfolder(olFolderInBox)
oFolders=oDefaultFolder.folders
FOR EACH oFolder IN oFolders
 ?oFolder.name
ENDFOR


&& Copier in message du Inbox à un autre dossier.

Local oOutlookObject,olNameSpace
#Define olFolderInBox 6
oOutlookObject = Createobject('Outlook.Application')
olNameSpace = oOutlookObject.GetNameSpace('MAPI')
oItems= olNameSpace.GetDefaultFolder(olFolderInBox).Items
For Each loItem In oItems
    If !loItem.unRead
            loitem.Move(olNameSpace.Folders(1).Folders(12))
    Endif
Next

&& Comment determiner si un nouveau courriel est arrivé avec BindEvents
You can use the following code to create a COM server DLL and take action when a new e-mail arrives in Outlook. Please note that only the NewMail procedure is functional, but you can add your own code to make the others functional.
Note: this code is based on http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dnfoxtk00/html/ft00j1.asp
Note2 : This code requires that VFPCOM Utility be installed in the target computer (http://www.microsoft.com/downloads/details.aspx?displaylang=en&FamilyID=1529819C-2CE8-4E89-895E-15209FCF4B2A)
Note3 : This will work in VFP7.0 and up

CODE
#DEFINE VFPCOM_CLSID  'VFPCOM.COMUTIL'
#DEFINE OUTLOOK_CLSID  'OUTLOOK.APPLICATION'
public goVFPCOM, goOutlook, goLink
goVFPCOM = create(VFPCOM_CLSID)
goOutlook = create(OUTLOOK_CLSID)
goLink = create('OutlookApplicationEvents')
goVFPCOM.BindEvents(goOutlook, goLink)
DEFINE CLASS OutlookApplicationEvents AS custom
  PROCEDURE ItemSend(Item,Cancel)
  ENDPROC
  PROCEDURE NewMail
  MessageBox('New Mail Has Arrived')
  ENDPROC
  PROCEDURE OptionsPagesAdd(Pages)
  ENDPROC
  PROCEDURE Quit
  ENDPROC
  PROCEDURE Reminder(Item)
  ENDPROC
  PROCEDURE Startup
  ENDPROC
ENDDEFINE

& Comment obtenir le contenue du champs notes dans les contacts Outlook

oOutlook=CREATEOBJECT('outlook.application')
oNameSpace=oOutlook.getNameSpace('mapi')
oDefaultFolder=oNameSpace.getdefaultfolder(10)
for each oItem in odefaultFolder.Items
   ?oitem.body
endfor
Commentaires
le 31/10/2008, BrunoB a écrit :
Bonjour,
J'ai essayé d'utiliser votre séquence pour "envoyer un simple courriel" mais j'obtiens une erreur : erreur dans le module ! variable 'MAILITEM' is not found. Que puis-je faire ?
J'ai également essayé une de vos autres séquences (envoyer un courriel HTML). Elle fonctionne très bien mais de manière trop automatique pour moi ! J'aurais aimé que le module ouvre Outlook avec déjà le nom du destinataire, ... mais n'envoie pas le courriel directement car je dois le compléter avant de l'envoyer.
Merci d'avance pour vos bons conseils.
le 31/10/2008, Mike Gagnon a écrit :
Tous les # DEFINE au haut de l'article s'applique aux exemples. Donc rajoute les tous au debut de ton code.
le 04/11/2008, BrunoB a écrit :
C'est super ! Merci Mike.
Pour info, je remplace ".Send" par ".display()" pour afficher la fenêtre Outlook sans envoyer le messge directement ce qui me permet de personnaliser le corps du message avant de l'envoyer.
le 06/11/2008, BrunoB a écrit :
Est-il possible de piloter un web mail (gmail) avec VFP ? Quelles seraient les fonctions pour envoyer un mail avec attachement ?
le 06/11/2008, Mike Gagnon a écrit :
Tu peux gérer GMail de Outlook.
le 26/11/2008, BrunoB a écrit :
Bonjour,
Peux-tu me dire comment mettre un attachement dont le nom est une variable et pas un nom fixe. Je fais un PDF juste avant qui a été sauvé sous un nom suivant la variable : select (ttoc(datetime(),1)) as nom_pdf
Il faudrait donc mettre en attachement :
.Attachments.Add('C:\mesdocpdf\nom_pdf') ?????
le 26/11/2008, Mike Gagnon a écrit :
BrunoB

Met le chemin et le nom dans une variable
oOutLookObject = CreateObject('Outlook.Application')
oEmailItem = oOutLookObject.CreateItem(0)
lcFile = 'c:\resizfrm.PRG.tft'
WITH oEmailItem
.Recipients.Add('moe@3stooges.com') && uses the Recipients collection
.Subject = 'Automation sample'
.Body = 'This is easy!'
.Attachments.Add(lcFile) && Note that the fully qualified path and file is required.
.Display
ENDWITH
le 22/04/2013, man006 a écrit :
Bonjour,
Comment utiliser la methode : SendAndReceive
olNameSpace.SendAndReceive(.F.)
message d'erreur !!!
www.atoutfox.org - Site de la Communauté Francophone des Professionnels FoxPro - v3.4.0 - © 2004-2024.
Cette page est générée par un composant COM+ développé en Visual FoxPro 9.0-SP2-HF3