Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 88
  • Last Modified:

Macro in Outlok 2010 to add sum of booked time this week and per week for the following 3 weeks

Dear expert,

Interested in a macro in outlook 2010 which provide the sum per week of booked time  in my calendar for this week and the following 3 weeks.

Br
JP
0
easycapital
Asked:
easycapital
  • 2
1 Solution
 
David LeeCommented:
Hi, JP.

Do you want this to run using fixed weeks (i.e. Sunday to Saturday) or do you want the week to start on the day the macro is run (e.g. if I run it today then each week would start on Wednesday and end on Tuesday)?  Also, what do you want to do with the sums once they're calculated (e.g. display them on screen, write them to a file)?
0
 
easycapitalAuthor Commented:
Dear BlueDevilFan,

1. Monday to Sunday.
2. Write to an excel file.

Thank you.

Br,
JP
0
 
easycapitalAuthor Commented:
Outlook calendar shows the week number.
0
 
ltlbearand3Commented:
I have been watching this question to see what kind of solution BlueDevilFan would come up with as I usually learn good things from his posts.  However, since it has been a few weeks I will post some code to hopefully get you started.  This code can run from within Excel and will find all calendar items in the default calendar for three weeks starting with the Monday of the current week and put the total in cell A1 in a Excel Workbook.

' ExpertExchange Question ID 28600516
' http://www.experts-exchange.com/Software/Office_Productivity/Groupware/Outlook/Q_28600516.html
' Expert: ltlbearand3 [http://www.experts-exchange.com/M_2469312.html]
'

Public Sub BookedTime()
    ' Required References:
    ' MICROSOFT EXCEL OBJECT LIBRARY
    
    Dim objCalendarFldr As Outlook.Folder
    Dim objAptItems As Outlook.Items
    Dim objFilteredApt As Outlook.Items
    Dim objAppt As Outlook.AppointmentItem
    Dim dteStart As Date
    Dim lngTotalTime As Long
    Dim objExcel As Excel.Application
    Dim objWorkbook As Excel.Workbook
    Dim objWorksheet As Excel.Worksheet
        
    Set objCalendarFldr = Session.GetDefaultFolder(olFolderCalendar)
    Set objAptItems = objCalendarFldr.Items
    
    'Find a Start Date of Monday
    dteStart = DateAdd("d", -Weekday(Date, vbMonday), Date)
    
    ' Filter the List
    With objAptItems
        .IncludeRecurrences = True
        .Sort "[Start]"
    End With
   
    Set objFilteredApt = objAptItems.Restrict("[Start] >= '" & Format$(dteStart, "mm/dd/yyyy hh:mm AMPM") & "' AND [End] <= '" & _
        Format$(DateAdd("d", 21, dteStart), "mm/dd/yyyy hh:mm AMPM") & "'")
    
    ' Calculate Total Time
    For Each objAppt In objFilteredApt
        lngTotalTime = lngTotalTime + objAppt.Duration
    Next

    ' Write to Excel
    Set objExcel = New Excel.Application
    objExcel.Visible = False
    
    Set objWorkbook = objExcel.Workbooks.Add
    Set objWorksheet = objWorkbook.Worksheets.Add
    
    objWorksheet.Range("A1").Value = lngTotalTime
    
    ' ***** UPDATE THE PATH WITH THE LOCATION YOU WANT **********
    objWorkbook.SaveAs "c:\EE_Q28600516.xlsx"
    objWorkbook.Close
        
    ' Clean up
    Set objCalendarFldr = Nothing
    Set objAptItems = Nothing
    Set objFilteredApt = Nothing
    Set objAppt = Nothing
    Set objWorksheet = Nothing
    Set objWorkbook = Nothing
    Set objExcel = Nothing
    

End Sub

Open in new window

0

Featured Post

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now