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

Isso retornará uma função de array e, portanto, deve inseri-lo usando CTRL + SHIFT + ENTER. 

Enjoy!

Referências: 

Tags: VBA, Outlook, Excel, feriado, holiday,