Login or Sign Up to become a member!
LessThanDot Sit Logo

LessThanDot

Community Wiki

Less Than Dot is a community of passionate IT professionals and enthusiasts dedicated to sharing technical knowledge, experience, and assistance. Inside you will find reference materials, interesting technical discussions, and expert tips and commentary. Once you register for an account you will have immediate access to the forums and all past articles and commentaries.

LTD Social Sitings

Lessthandot twitter Lessthandot Linkedin Lessthandot friendfeed Lessthandot facebook Lessthandot rss

Note: Watch for social icons on posts by your favorite authors to follow their postings on these and other social sites.

Navigation

Google Ads

Create Outlook Appointment, Shared Folder

From Wiki

Jump to: navigation, search

This example creates an Outlook Appointment and then moves it to a folder called Shared Calendar.

textLine number Off | Hide | Select all
  1. Sub CreateCalEntry(LeadDate As Date, DueDate As Date, _
  2.             Subject As String, Location As String, Body As String, _
  3.             Optional AddToShared As Boolean = True)
  4.  
  5. 'Lead date = expect notify from data
  6. 'Due date - expect event due date
  7. 'Add to shared - add item to shared calendar, hard coded as 'Shared Calendar'
  8.  
  9. Const olApItem = 1
  10.  
  11. Dim apOL As Object 'Outlook.Application
  12. Dim oItem As Object 'Outlook.AppointmentItem '
  13. Dim objFolder As Object 'MAPI Folder
  14.    
  15.     Set apOL = CreateObject("Outlook.Application")
  16.     Set objFolder = GetFolder("Public Folders/All Public Folders/Shared Calender")
  17.     Set oItem = apOL.CreateItem(olApItem)
  18.    
  19.     With oItem
  20.         .Subject = Subject
  21.         .Location = Location
  22.         .Body = Body
  23.        
  24.         If IsDate(LeadDate) Then
  25.             .Start = DueDate
  26.         Else
  27.             .Start = DueDate
  28.         End If
  29.        
  30.         If AddToShared = True Then
  31.             .Move objFolder
  32.         End If
  33.        
  34.         .Display
  35.     End With
  36.  
  37.     Set oItem = Nothing
  38.     Set apOL = Nothing
  39.  
  40. End Sub
  41.  
  42. Public Function GetFolder(strFolderPath As String) As Object 'MAPIFolder
  43. ' strFolderPath needs to be something like
  44. '   "Public Folders\All Public Folders\Company\Sales" or
  45. '   "Personal Folders\Inbox\My Folder"
  46. 'This code is from: http://www.outlookcode.com/d/code/getfolder.htm
  47.  
  48. Dim apOL As Object 'Outlook.Application
  49. Dim objNS As Object 'Outlook.NameSpace
  50. Dim colFolders As Object 'Outlook.Folders
  51. Dim objFolder As Object 'Outlook.MAPIFolder
  52. Dim arrFolders() As String
  53. Dim I As Long
  54.  
  55.     strFolderPath = Replace(strFolderPath, "/", "\")
  56.     arrFolders() = Split(strFolderPath, "\")
  57.    
  58.     Set apOL = CreateObject("Outlook.Application")
  59.     Set objNS = apOL.GetNamespace("MAPI")
  60.    
  61.     On Error Resume Next
  62.    
  63.     Set objFolder = objNS.Folders.Item(arrFolders(0))
  64.    
  65.     If Not objFolder Is Nothing Then
  66.         For I = 1 To UBound(arrFolders)
  67.             Set colFolders = objFolder.Folders
  68.             Set objFolder = Nothing
  69.             Set objFolder = colFolders.Item(arrFolders(I))
  70.            
  71.             If objFolder Is Nothing Then
  72.                 Exit For
  73.             End If
  74.         Next
  75.     End If
  76.  
  77.     Set GetFolder = objFolder
  78.     Set colFolders = Nothing
  79.     Set objNS = Nothing
  80.     Set apOL = Nothing
  81.  
  82. End Function

619 Rating: 1.0/5 (1 vote cast)

Retrieved from "http://wiki.lessthandot.com/index.php/Create_Outlook_Appointment%2C_Shared_Folder"

Powered by MediaWiki GNU Free Documentation License 1.2
Valid XHTML | Valid CSS