Export do Excela zaznaczonych wiadomości lub wydarzeń kalendarzowych
by vbatools on May.18, 2011, under Excel, Outlook, Porady
Zwykle proste działania spędzają nam sen z powiek. Jednym z takich działań jest pobranie danych zaznaczonych obiektów i zapis np do Excela.
Poniżej przedstawiam dwa proste makra realizujące pow działania. Nie zawierają one elementów, które dla początkujących programistów mogą stawiać w zakłopotanie. Wywołać je należy ze środowiska developerskiego Outlooka. Można się na nich wzorować i odnieść do innego typu elementów.
Kod dla zaznaczonych maili:
Sub Export_zaznacznych_maili_do_excela() 'MVP OShon from VBATools.pl Dim XLApp As Object, wkb As Object, wks As Object Dim oItem As MailItem, x& Set XLApp = CreateObject("Excel.Application") XLApp.Visible = True XLApp.Workbooks.Add XLApp.Application.ScreenUpdating = False Set wkb = XLApp.ActiveWorkbook Set wks = wkb.Sheets(1) wks.Activate For Each oItem In Application.ActiveExplorer.Selection x = x + 1 With wks.Cells(x, 1) .value = Format(oItem.CreationTime, "YYYY-MM-DD HH:MM") .Offset(, 1) = oItem.Subject .Offset(, 2) = oItem.SenderName .Offset(, 3) = oItem.To .Offset(, 4) = oItem.CC .Offset(, 5) = oItem.BCC .Offset(, 6) = oItem.Body .Offset(, 6).RowHeight = 15 'itp... End With Next With wks .Rows("1:1").Insert Shift:=xlDown .Range("A1").value = "Data" .Range("B1").value = "Tytuł wiadomości" .Range("C1").value = "Od (konto)" .Range("D1").value = "Do (adresaci)" .Range("E1").value = "Do wiadomości" .Range("F1").value = "UDW (ukryci)" .Range("G1").value = "Treść wiadomości" .Columns(1).Columns.AutoFit End With XLApp.Application.ScreenUpdating = True Set wkb = Nothing Set wks = Nothing Set XLApp = Nothing End Sub
Kod dla zaznaczonych wydarzeń kalendarzowych:
Sub Export_zaznacznych_wydarzen_do_excela() 'MVP OShon from VBATools.pl Dim XLApp As Object, wkb As Object, wks As Object Dim oItem As AppointmentItem, x& Set XLApp = CreateObject("Excel.Application") XLApp.Visible = True XLApp.Workbooks.Add XLApp.Application.ScreenUpdating = False Set wkb = XLApp.ActiveWorkbook Set wks = wkb.Sheets(1) wks.Activate For Each oItem In ActiveExplorer.Selection x = x + 1 With wks.Cells(x, 1) .value = Trim(oItem.Subject) .Offset(, 1) = oItem.Start .Offset(, 2) = oItem.End .Offset(, 3) = Trim(oItem.Location) .Offset(, 4) = oItem.IsRecurring If oItem.IsRecurring Then .Offset(, 5) = CLng(oItem.GetRecurrencePattern.PatternEndDate - oItem.Start) Select Case oItem.GetRecurrencePattern.RecurrenceType Case 1: .Offset(, 6) = "Co tydzień" Case 2: .Offset(, 6) = "Co miesiąc" Case 5: .Offset(, 6) = "Co rok" End Select If .Offset(, 5) < 900000 Then .Offset(, 7) = .Offset(, 1) + .Offset(, 5) Else .Offset(, 7) = "Brak końca" End If 'itd.. End With Next With wks .Rows("1:1").Insert Shift:=xlDown .Range("A1").value = "Nazwa terminu" .Range("B1").value = "Data początku" .Range("C1").value = "Data końca" .Range("D1").value = "Lokalizacja" .Range("E1").value = "Cykliczny" .Range("F1").value = "Przez il. dni" .Range("G1").value = "Ilość powróżeń" .Range("H1").value = "Do dnia" .Columns(1).Columns.AutoFit End With XLApp.Application.ScreenUpdating = True Set wkb = Nothing Set wks = Nothing Set XLApp = Nothing End Sub
Dla pobrania kolejnych dat cyklicznych wydarzeń można zastosować pętlę:
Dim oItem as AppointmentItem For Each oItem In ActiveExplorer.Selection If oItem.IsRecurring = True Then Debug.Print oItem.Subject & _ " | cykl " & oItem.GetRecurrencePattern.RecurrenceType & _ " | start " & oItem.Start & _ " | stop " & oItem.End & _ " | koniec " & oItem.GetRecurrencePattern.PatternEndDate & _ " | il dni " & CLng(oItem.GetRecurrencePattern.PatternEndDate - oItem.Start) If oItem.GetRecurrencePattern.PatternEndDate <> "4500-12-31 23:59:00" Then Dim Co_il_dni&, x&, dz_start As Date: dz_start = oItem.Start Select Case oItem.GetRecurrencePattern.RecurrenceType Case 1: Co_il_dni = 7 Case 2: Co_il_dni = 30 Case 5: Co_il_dni = 365 End Select For x = 0 To CLng(oItem.GetRecurrencePattern.PatternEndDate - oItem.Start) Debug.Print DateAdd("d", x, dz_start) & " | " & Format(DateAdd("d", x, dz_start), "dddd") x = x + Co_il_dni - 1 Next x End If End If Next
Ostatni kod nie uwzględnia zmieniających się dni w miesięcu oraz zmieniających się ilości dni w roku przystępnym. Z czasem kod ten poprawię.
Eksport do MS Excel, jest realizowany metodą “późnego wiązania”, bez konieczności podpinania kontrolki w referencjach projektu.
Realizacja działania kodem jest istotna w przypadku blokad administracyjnych (praca w domenie) a co za tym idzie, instalacji dodatków nie autoryzowanych przez dział IT danego przedsiębiorstwa.
(c) Shon Oskar – www.VBATools.pl
Wszelkie prawa zastrzeżone. Żadna część ani całość tego artykułu nie może być powielana ani publikowana bez zgody autora.
January 9th, 2015 on 10:23
Witam, jest możliwość zmodyfikowania kodu tak aby po włączeniu makra wyskakiwał jakiś komunikat lub najlepiej okno w którym użytkownik zaznaczył by interesujące go maile ?
January 9th, 2015 on 13:37
W kodzie jest pętla .ActiveExplorer.Selection czyli dla pozycji wcześniej zaznaczonych. Grupę zaznaczymy z Shiftem a wybiórczo z wciśniętym klawiszem Ctrl.