Hello and welcome to our community! Is this your first visit?
Register
Enjoy an ad free experience by logging in. Not a member yet? Register.
Results 1 to 2 of 2
  1. #1
    New to the CF scene
    Join Date
    May 2019
    Posts
    2
    Thanks
    0
    Thanked 0 Times in 0 Posts

    OUtlook Macro help?

    Hi,

    I'm trying to build a macro in outlook to automatically ad a 15 minute buffer before my meetings and send the invite to the meeting room. I have everything working except it will not populate the meeting room in the "To" field. I think it may be due to my macro is creating an appointment, not a meeting. How do I fix it? Below is the code I have so far.

    Code:
    Public Sub AddTravelTime()
      Dim coll As VBA.Collection
      Dim obj As Object
      Dim Appt As Outlook.AppointmentItem
      Dim Travel As Outlook.AppointmentItem
      Dim Items As Outlook.Items
      Dim Before&, After&
      Dim Category$, Subject$
    
      '1. Block minutes before and after the appointment
      Before = 30
      After = 30
    
      '2. Skip this if the default values never change
      Before = InputBox("Minutes before:", , Before)
      After = InputBox("Minutes after:", , After)
    
      If Before = 0 And After = 0 Then Exit Sub
    
      '3. Assign this category
      Category = "Travel"
    
      Set coll = GetCurrentItems
      If coll.Count = 0 Then Exit Sub
      For Each obj In coll
        If TypeOf obj Is Outlook.AppointmentItem Then
          Set Appt = obj
          If TypeOf Appt.Parent Is Outlook.AppointmentItem Then
            Set Items = Appt.Parent.Parent.Items
          Else
            Set Items = Appt.Parent.Items
          End If
    
          '4. Use the main appointment's subject
          Subject = Appt.Subject
          Location = Appt.Location
          Resources = Appt.Resources
    
          If Before > 0 Then
            Set Travel = Items.add
            Travel.Subject = Subject
            Travel.Location = Location
            Travel.Resources = Resources
            Travel.Start = DateAdd("n", -Before, Appt.Start)
            Travel.Duration = Before
            Travel.Categories = Category
            Travel.Save
          End If
    
          If After > 0 Then
            Set Travel = Items.add
            Travel.Subject = Subject
            Travel.Start = Appt.End
            Travel.Duration = After
            Travel.Categories = Category
            Travel.Save
          End If
        End If
      Next
    End Sub
    
    Private Function GetCurrentItems(Optional IsInspector As Boolean) As VBA.Collection
      Dim coll As VBA.Collection
      Dim Win As Object
      Dim Sel As Outlook.Selection
      Dim obj As Object
      Dim i&
    
      Set coll = New VBA.Collection
      Set Win = Application.ActiveWindow
    
      If TypeOf Win Is Outlook.Inspector Then
        IsInspector = True
        coll.add Win.CurrentItem
      Else
        IsInspector = False
        Set Sel = Win.Selection
        If Not Sel Is Nothing Then
          For i = 1 To Sel.Count
            coll.add Sel(i)
          Next
        End If
      End If
      Set GetCurrentItems = coll
    End Function

  2. #2
    New to the CF scene
    Join Date
    May 2019
    Posts
    2
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Sorry everyone, it wouldn't let me edit my post. Below is my newest code.

    Code:
    Public Sub Setup()
      Dim coll As VBA.Collection
      Dim obj As Object
      Dim Appt As Outlook.AppointmentItem
      Dim Setup As Outlook.AppointmentItem
      Dim Items As Outlook.Items
      Dim Before&, After&
      Dim Category$, Subject$
    
      '1. Block minutes before and after the appointment
      Before = 15
    
      '2. Skip this if the default values never change
      Before = InputBox("Minutes before:", , Before)
    
      If Before = 0 Then Exit Sub
    
      '3. Assign this category
      Category = "Setup"
    
      Set coll = GetCurrentItems
      If coll.Count = 0 Then Exit Sub
      For Each obj In coll
        If TypeOf obj Is Outlook.AppointmentItem Then
          Set Appt = obj
          If TypeOf Appt.Parent Is Outlook.AppointmentItem Then
            Set Items = Appt.Parent.Parent.Items
          Else
            Set Items = Appt.Parent.Items
          End If
    
          '4. Use the main appointment's attribute
          Subject = Appt.Subject
          Location = Appt.Location
          Resources = Appt.Resources
    
          If Before > 0 Then
            Set Setup = Items.add
            Setup.Subject = Subject + " setup"
            Setup.Location = Location
            Setup.Resources = Resources
            Setup.Start = DateAdd("n", -Before, Appt.Start)
            Setup.Duration = Before
            Setup.Categories = Category
            Setup.Display
          End If
        End If
      Next
    End Sub
    
    Private Function GetCurrentItems(Optional IsInspector As Boolean) As VBA.Collection
      Dim coll As VBA.Collection
      Dim Win As Object
      Dim Sel As Outlook.Selection
      Dim obj As Object
      Dim i&
    
      Set coll = New VBA.Collection
      Set Win = Application.ActiveWindow
    
      If TypeOf Win Is Outlook.Inspector Then
        IsInspector = True
        coll.add Win.CurrentItem
      Else
        IsInspector = False
        Set Sel = Win.Selection
        If Not Sel Is Nothing Then
          For i = 1 To Sel.Count
            coll.add Sel(i)
          Next
        End If
      End If
      Set GetCurrentItems = coll
    End Function


 

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •