✔ Programação GLOBAL®: VBA Outlook - Importando feriados para o Outlook a partir de Lista no MS Excel - Importing Outlook's holiday list into a function in MS Excel

Este artigo lhe mostrará como recuperar feriados armazenados no MS Outlook e devolvê-los ao MS Excel. Estamos pressupondo que as férias tenham sido importados para o MS Outlook.

Para importar os feriados no MS Outlook, siga a seguinte instrução: Tools à Options àPreferences à Calendar Options. Em seguida, clique em adicionar feriados e escolha o país para o qual deseja as férias, pode escolher quantos quiser.

Note que o código funcionará em Inglês, e não em outras línguas. Mas pode adaptá-lo para a sua língua. Isso acontece porque alguns dos campos do calendário foram traduzidos para as línguas locais, enquanto outros não. Pode perceber que o campo Categories é Categorias em espanhol, por exemplo.

Para começar, adicione um novo módulo de classe ao seu projeto. Então vá para Tool à References àMicrosoft Outlook xx Object Library e instale a biblioteca. Vamos usar a biblioteca de objeto do MS Outlook para acessar alguns dos seus recursos, bem como facilitar o processo de programação.

Renomeie a classe que adicionou para clsHolidays e abra-a, e insira o código abaixo:

Function Holidays(ByVal StartsOn As String, ByVal EndsOn As String, _
    Location As String) As Variant

    Location As String) As Variant

    Dim appOutlook      As Outlook.Application

    Dim nSpace          As Outlook.Namespace

    Dim calFolder       As Outlook.MAPIFolder

    Dim calItem         As Outlook.AppointmentItem

    Dim filterItems     As Outlook.Items

    Dim strFilter       As

    Dim holName         As New Collection

    Dim holDate         As New Collection

    Dim i               As

    Dim aHoliday

    Set appOutlook = CreateObject("Outlook.Application")

    Set nSpace = appOutlook.GetNamespace("MAPI")

    Set calFolder = nSpace.GetDefaultFolder(olFolderCalendar)

    strFilter = "[Categories]= 'Holiday' And [Location]= '"

    strFilter = strFilter & Location & "'" & " And [Start]>= '"

    strFilter = strFilter & StartsOn & "'" & " And [End]<= '"

    strFilter = strFilter & EndsOn & "'"

    Set filterItems = calFolder.Items.Restrict(strFilter)

    filterItems.Sort "[Start]", False

    On Error Resume

    For Each calItem In filterItems

        holName.Add calItem.Subject, calItem.Subject

        holDate.Add calItem.Start, CStr(calItem.Start)

    Next

    ReDim aHoliday(holName.Count - 1, 1)

    For i = 0 To holName.Count - 1

        aHoliday(i, 0) = holName.Item(i + 1)

        aHoliday(i, 1) = holDate.Item(i + 1)

    Next

    Holidays = aHoliday

    Set appOutlook =

    Set nSpace =

    Set calFolder =

    Set calItem =

    Set filterItems =

    Set holName =

    Set holDate = Nothing

End
Function

Com o código no módulo, insira agora um novo módulo e neste, adicione a seqüência de código abaixo:

Function Holidays(InitialDate As String, EndDate As String,_

   Country As String) As Variant



   Dim Holiday As New clsHolidays

   Let Holidays = Holiday.Holidays(InitialDate, EndDate, Country)

End Function