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
EndFunction
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 VariantDim 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,
Nenhum comentário:
Postar um comentário