title: Export Outlook Calendar to Excel to have that sheet used as data to fill another
body: <p><strong>Background:</strong>
  We have a weekly meeting that we all sit around and dish out our schedules and manually input them into a master excel sheet. This is inconvenient, time consuming, and inefficient. We would like to automate the process.</p>
  
  <p><strong>What we need:</strong>
  Outlook Calendars (7 in total) -> Master Excel Sheet -> Member Schedule Excel Sheet</p>
  
  <p><strong>Outlook needs:</strong></p>
  
  <ol>
  <li>We need all 7 outlook calendars to go into one single excel
  sheet. We want it to happen on a weekly basis on Fridays.</li>
  <li>The excel sheet needs to have variables for the owner, category,
  subject, start date, end date, attendees (this is already in the code below)</li>
  <li>The code below needs to be edited to where it is automatic and
  not manual. At the moment we have to manually select the dates that
  the code draws from on the calendar. We want it to be an automated
  process to take place every Friday evening.</li>
  <li>Also, we have a system of classification in place to say if the
  file is confidential or not. This has caused problems with the code
  when trying to save since it cannot tell the program what to do.
  This is a minor problem that we could probably work around, but
  would be nice to have it automated as well.</li>
  </ol>
  
  <hr>
  
  <p><strong>Master excel sheet needs:</strong></p>
  
  <ol>
  <li>The 7 calendars need to be imported into this one sheet</li>
  <li>The variables mentioned above should be the columns</li>
  <li>The code below does this well, but as mentioned, we need it to be automated</li>
  </ol>
  
  <hr>
  
  <p><strong>Member Schedule Excel Sheet:</strong></p>
  
  <ol>
  <li><p>This excel sheet has a list of the members with dates by day and
  month. Example:</p>
  
  <p><a href="https://i.stack.imgur.com/ROzNj.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/ROzNj.png" alt="enter image description here"></a></p></li>
  <li><p>We need this excel sheet to be filled based on criteria from the
  master excel sheet</p>
  
  <p>a. Example: if Person1 has a vacation scheduled for 10/04/2017 to
  10/10/2017, we need the corresponding boxes filled with a “V” on
  those dates for that person inside of the excel sheet.</p></li>
  <li><p>The criteria needed to be met for the sheet are:</p>
  
  <p>a. Date of event matches on both sheets</p>
  
  <p>b. Owner of Calendar matches Person (this will have to be searched
  by keyword… example: First Last on the Member Schedule Excel sheet
  will be displayed as “first.last@email.com\calendar “ on the master
  excel sheet.)</p>
  
  <p>c. Look for certain keywords (ie. “vacation”, “persoanl”, etc… we
  will set these) inside of the master sheet subject box column to
  determine if the specific date and person has added is a vacation
  day, personal day, half day vacation, etc. This command should fill
  in the sheet with the appropriate symbol to indicate what type of
  day it is</p>
  
  <p>d. If an event contains 2 or more of the Persons, then the column
  should be yellow with “Major Events/Meetings” being filled with the
  name of the event</p></li>
  <li>The criteria need to return the correct code corresponding with
  the correct person, date and event</li>
  <li>If an event is more than one day, the master excel will only have
  the start date and end date, we will need for all days in between to
  be highlighted with the correct symbol.</li>
  </ol>
  
  <p>So far, the code I have made is:</p>
  
  <pre><code>=IF(AND(ISNUMBER(SEARCH("dakota.mccarty",[Macros.xlsx]Sheet1!$A:$A)),(K$3=[Macros.xlsx]Sheet1!$D:$D),(COUNTIF( [Macros.xlsx]Sheet1!$C:$C, "**vacation**"))), $B$15, "0")
  </code></pre>
  
  <p>This searches if Vacation is in the subject and returns a “V”</p>
  
  <p>As you can see, its long and does only one thing...</p>
  
  <p>This is the code to bring calendars from Outlook into Excel:
  It works, but isn't automated. </p>
  
  <pre><code>  Sub ExportAppointmentsToExcel()
      'On the next line, the list of calendars you want to export.  Each entry is the path to a calendar.  Entries are separated by a comma.
      Const CAL_LIST = "user1\Calendar, user2\Calendar, user3\Calendar , etc"
      'On the next line, edit the path to and name of the Excel spreadsheet to export to
      Const EXCEL_FILE = "c:\users\415085\desktop\Macros\Macros.xlsx"
      Const SCRIPT_NAME = "Export Appointments to Excel (Rev 2)"
      Const xlAscending = 1
      Const xlYes = 1
      Dim olkFld As Object, _
          olkLst As Object, _
          olkRes As Object, _
          olkApt As Object, _
          olkRec As Object, _
          excApp As Object, _
          excWkb As Object, _
          excWks As Object, _
          lngRow As Long, _
          lngCnt As Long, _
          strFil As String, _
          strLst As String, _
          strDat As String, _
          datBeg As Date, _
          datEnd As Date, _
          arrTmp As Variant, _
          arrCal As Variant, _
          varCal As Variant
      strDat = InputBox("Enter the date range of the appointments to export in the form ""mm/dd/yyyy to mm/dd/yyyy""", SCRIPT_NAME, Date &amp; " to " &amp; Date)
      arrTmp = Split(strDat, "to")
      datBeg = IIf(IsDate(arrTmp(0)), arrTmp(0), Date) &amp; " 12:00am"
      datEnd = IIf(IsDate(arrTmp(1)), arrTmp(1), Date) &amp; " 11:59pm"
      Set excApp = CreateObject("Excel.Application")
      Set excWkb = excApp.Workbooks.Add()
      Set excWks = excWkb.Worksheets(1)
      'Write Excel Column Headers
      With excWks
          .Cells(1, 1) = "Calendar"
          .Cells(1, 2) = "Category"
          .Cells(1, 3) = "Subject"
          .Cells(1, 4) = "Starting Date"
          .Cells(1, 5) = "Ending Date”
          .Cells(1, 6) = "Attendees"
      End With
      lngRow = 2
      arrCal = Split(CAL_LIST, ",")
      For Each varCal In arrCal
          Set olkFld = OpenOutlookFolder(CStr(varCal))
          If TypeName(olkFld) &lt;&gt; "Nothing" Then
              If olkFld.DefaultItemType = olAppointmentItem Then
                  Set olkLst = olkFld.Items
                  olkLst.Sort "[Start]"
                  olkLst.IncludeRecurrences = True
                  Set olkRes = olkLst.Restrict("[Start] &gt;= '" &amp; Format(datBeg, "ddddd h:nn AMPM") &amp; "' AND [Start] &lt;= '" &amp; Format(datEnd, "ddddd h:nn AMPM") &amp; "'")
                  'Write appointments to spreadsheet
                  For Each olkApt In olkRes
                      'Only export appointments
                      If olkApt.Class = olAppointment Then
                          strLst = ""
                          For Each olkRec In olkApt.Recipients
                              strLst = strLst &amp; olkRec.Name &amp; ", "
                          Next
                          If strLst &lt;&gt; "" Then strLst = Left(strLst, Len(strLst) - 2)
                          'Add a row for each field in the message you want to export
                          excWks.Cells(lngRow, 1) = olkFld.FolderPath
                          excWks.Cells(lngRow, 2) = olkApt.Categories
                          excWks.Cells(lngRow, 3) = olkApt.Subject
                          excWks.Cells(lngRow, 4) = Format(olkApt.Start, "mm/dd/yyyy")
                          excWks.Cells(lngRow, 5) = Format(olkApt.End, "mm/dd/yyyy")
                          excWks.Cells(lngRow, 6) = strLst
                          lngRow = lngRow + 1
                          lngCnt = lngCnt + 1
                      End If
                  Next
              Else
                  MsgBox "Operation cancelled.  The selected folder is not a calendar.  You must select a calendar for this macro to work.", vbCritical + vbOKOnly, SCRIPT_NAME
              End If
          Else
              MsgBox "I could not find a folder named " &amp; varCal &amp; ".  Folder skipped.  I will continue processing the remaining folders.", vbExclamation + vbOKOnly, SCRIPT_NAME
          End If
      Next
      excWks.Columns("A:I").AutoFit
      excWks.Range("A1:I" &amp; lngRow - 1).Sort Key1:="Category", Order1:=xlAscending, Header:=xlYes
      excWks.Cells(lngRow, 8) = "=sum(H2:H" &amp; lngRow - 1 &amp; ")"
      excWkb.SaveAs EXCEL_FILE
      excWkb.Close
      MsgBox "Process complete.  I exported a total of " &amp; lngCnt &amp; " appointments were exported.", vbInformation + vbOKOnly, SCRIPT_NAME
      Set excWks = Nothing
      Set excWkb = Nothing
      Set excApp = Nothing
      Set olkApt = Nothing
      Set olkLst = Nothing
      Set olkFld = Nothing
  End Sub
  Private Function OpenOutlookFolder(strFolderPath As String) As Outlook.MAPIFolder
      Dim arrFolders As Variant, _
          varFolder As Variant, _
          bolBeyondRoot As Boolean
      On Error Resume Next
      If strFolderPath = "" Then
          Set OpenOutlookFolder = Nothing
      Else
          Do While Left(strFolderPath, 1) = "\"
              strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)
          Loop
          arrFolders = Split(strFolderPath, "\")
          For Each varFolder In arrFolders
              Select Case bolBeyondRoot
                  Case False
                      Set OpenOutlookFolder = Outlook.Session.Folders(varFolder)
                      bolBeyondRoot = True
                  Case True
                      Set OpenOutlookFolder = OpenOutlookFolder.Folders(varFolder)
              End Select
              If Err.Number &lt;&gt; 0 Then
                  Set OpenOutlookFolder = Nothing
                  Exit For
              End If
          Next
      End If
      On Error GoTo 0
  End Function
  </code></pre>
  
  <p>Let me know if you have any other questions or confusion, I am struggling real hard with this one.</p>
  
  <p>So far I have this:</p>
  
  <pre><code>=IF(AND(ISNUMBER(SEARCH("dakota.mccarty",[Macros.xlsx]Sheet1!$A:$A)),(COUNTIF([Macros.xlsx]Sheet1!$D:$D,C3)),(COUNTIF([Macros.xlsx]Sheet1!$C:$C,"Personal"))),$B$15, "0")
  </code></pre>
  
  <p>I need the “Personal” to return a TRUE match only if it matches the date in the underlined COUNTIF (C3, is a date that is being matched with column D on the Macros sheet). I just don’t know how to write that. I have tried a few things and keep failing.</p>
  
  <p>I really need the first and second logics to be met THEN allow for the third logic to be met to determine if its true or not. So, the first and second logics are like a large filter, then the third (and other logics after) will be the final filter of what makes the sheet.</p>