Usefull functions with Outlook Automation
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
LOCAL oOutlook,oNameSpace,oDefaultFolder
oOutlook = CREATEOBJECT('outlook.application')
oNameSpace = oOutlook.getnamespace('MAPI')
oDefaultFolder=oNameSpace.GetDefaultFolder(olFolderCalendar) &&Calendar
oDefaultFolder.display()
Display Outlook's contact folder
CODE
LOCAL oOutlook,oNameSpace,oDefaultFolder
oOutlook = CREATEOBJECT('outlook.application')
oNameSpace = oOutlook.getnamespace('MAPI')
oDefaultFolder=oNameSpace.GetDefaultFolder(olFolderContacts) &&Contact
oDefaultFolder.display()
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('=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
页:
[1]