Usefull functions with Outlook Automation

最新推荐文章于 2023-10-18 19:27:43 发布

weixin_30629977

最新推荐文章于 2023-10-18 19:27:43 发布

阅读量372

点赞数

原文链接：http://www.cnblogs.com/walter_wang/archive/2009/02/13/1390377.html

版权

Here are various ways to access different folders in Outlook via VFP automation:

Basic #DEFINE
#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

Display Outlook's calendar

CODE

Display Outlook's contact folder

CODE

How to use the find method, to locate a contact with a userdefined field 'BalanceDue' set to a numeric value.

CODE

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

Retrieve Outlook's contact, name and email address

CODE

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

Adding a new field and a value to the Contacts

CODE

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

Check for unread messages in the Inbox

CODE

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

Retrieve appointements in Outlook's calendar

CODE

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

Delete an appointment

CODE

#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

Send an e-mail without attachment

CODE

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

Send an e-mail with attachment

CODE

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

Note this is also found in FAQ184-2838
Retrieve attachements for all e-mail in the inbox

CODE

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

How to change (edit) information in the Contacts folder

CODE

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

Adding a folder in Outlook

CODE

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.

How to find the names of the folders within the inbox folder

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

Moving messages from the Inbox to another folder
The trick is to determine the folder ID number of your 'Seen' folder, once you have determined that (Typically the folder ID number is in order of creation, for example I just created a folder called 'seen' and determined that the folder was the 12th folder to be created) , that following will do it for you, it will move all Read messages to the folder number 12.

CODE

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

How to determine when new mail has arrived using 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