Microsoft Outlook troubleshooting

W lekcji piątej chcę opisać rozwiązanie pozwalające na umieszczenie obiektu typu „wydarzenie kalendarzowe” w wiadomości email. Przydatność takiego działania może wiązać się z chęcią poinformowania odbiorcy wiadomości o wydarzeniu.

Możemy przyjąć, że masz email jest elementem strategii marketingowej, a umieszczenie w nim załącznika tego typu sprawi, że zainteresowana wydarzeniem osoba będzie w łatwy sposób mogła dodać je w swoim Outlooku (bez konieczności deklaracji obecności czy odpowiedzi na zaproszenie). Ponieważ wiadomość przygotowywana jest w formie załącznika, jej treść może być przygotowana charakterystycznie co do stylu i preferencji nadawcy.

Artykuły z serii „lekcja” przedstawiają propozycje przygotowania narzędzia i umożliwiają prostą implementację interfejsu po przez (pobranie gotowego interfejsu) i zaimportowanie w środowisku developera kodu VBA. Po rozpakowaniu pobranego pliku należy osadzić go na miejsce drzewa projektu (analogicznie jak przedstawiono to w wersjach poprzednich).

Aby wywołać osadzoną formę należy uruchomić procedurę wg poniższych linii kodu:
 
Option Explicit
 
Sub Formatka_zaproszenia()
    Zaproszenie.Show
End Sub
 
Uruchomienie interfejsu zaplanowane jest tak, aby realizowała opisane pow. zadanie na otwartej wiadomości email.
 
Uruchomienie powyższej procedury, spowoduje wywołanie formy (Rys.1.) składającej się z: dwóch pól tekstowych, jednego checkboxa, kontrolki TimePicker (z pakietu biblioteki mscomct2.ocx), jednego przycisku, siedmiu etykiet oraz pięciu Combo boxów.
 
Interfejs programu tworzącego przypomnienie o wydarzeniu
Rys.1. Interfejs programu tworzącego przypomnienie o wydarzeniu.
 
Aby samodzielnie przygotować środowisko do tego zadania należy się zapoznać z poniższym kodem VBA umieszczonym w formie interfejsu:
 
Option Explicit On

Private Sub Anuluj_Click()
    Unload(Me)
End Sub

Private Sub DTPicker1_Change()
    Call wlacz_wstaw()
End Sub

Private Sub Godzina_do_Change()
    If Format(Godzina_od.text, "HH") > Format(Godzina_do.text, "HH") Then _
    Godzina_od.text = Godzina_do.text
End Sub

Private Sub Godzina_od_Change()
    If Format(Godzina_od.text, "HH") > Format(Godzina_do.text, "HH") Then _
    Godzina_do.text = Godzina_od.text
End Sub

Private Sub Przypomnienie_ustaw_Click()
    If Przypomnienie_ustaw.value = True Then
        Przypomnienie.Enabled = True
    Else
        Przypomnienie.Enabled = False
    End If
End Sub

Private Sub Sala_Change()
    Call wlacz_wstaw()
End Sub

Private Sub Temat_Change()
    Call wlacz_wstaw()
End Sub

Private Sub wlacz_wstaw()
    If Len(Trim(Temat.text)) > 0 And Len(Trim(Sala.text)) > 0 And _
        Format(DTPicker1.value, "YYYY-MM-DD") >= Format(Now, "YYYY-MM-DD") Then
        Wstaw.Enabled = True
    Else
        Wstaw.Enabled = False
    End If
End Sub

Private Sub UserForm_Initialize()
    DTPicker1.value = Now
    Dim x&
    For x = 0 To 240
        Przypomnienie.AddItem(x)
        x = x + 9
    Next x
    Przypomnienie.ListIndex = 0
    For x = 8 To 21
        Godzina_od.AddItem(x & ":00")
        Godzina_od.AddItem(x & ":30")
        Godzina_do.AddItem(x & ":00")
        Godzina_do.AddItem(x & ":30")
    Next x
    Godzina_od.text = Format(Now, "HH") & ":00"
    Godzina_do.text = Format(Now, "HH") & ":00"

    Call listLocation()
End Sub

Private Sub listLocation()
    Dim colCalendar As Outlook.Items, aItems As AppointmentItem, NoDupes As New Collection, _
        x&, jest As Boolean, i&, j&, Swap1, Swap2, item
    colCalendar = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar).Items
    For Each aItems In colCalendar
        DoEvents()
        jest = False
        If Len(Trim(aItems.LOCATION)) = 0 Then GoTo nastepny
        If NoDupes.Count = 0 Then NoDupes.Add(aItems.LOCATION)
        For x = 1 To NoDupes.Count
            If UCase(NoDupes(x)) = UCase(Trim(aItems.LOCATION)) Then jest = True
        Next x
        If jest = False Then NoDupes.Add(Trim(aItems.LOCATION))
nastepny:
    Next

    For i = 1 To NoDupes.Count - 1
        For j = i + 1 To NoDupes.Count
            If NoDupes(i) > NoDupes(j) Then
                Swap1 = NoDupes(i)
                Swap2 = NoDupes(j)
                NoDupes.Add(Swap1, before:=j)
                NoDupes.Add(Swap2, before:=i)
                NoDupes.Remove(i + 1)
                NoDupes.Remove(j + 1)
            End If
        Next j
    Next i

    For Each item In NoDupes
        Sala.AddItem(item)
    Next item
End Sub

Private Sub Wstaw_Click()
    Dim F&, file$, Katalog$, strDestFolderPath$
    F = FreeFile

    Katalog = "C:\Temp"
    On Error Resume Next
    MkDir(Katalog)
    On Error GoTo 0

    strDestFolderPath = Katalog & "\" & "Przypomnienie.ics"
    If FileExists(strDestFolderPath) = True Then Kill(strDestFolderPath)

        Open strDestFolderPath For Output As #F
            Print #F, "BEGIN: VCALENDAR"
            Print #F, "BEGIN: VEVENT"
            Print #F, "DTSTART:" & Format(DTPicker1.value, "YYYYMMDD") & _
                    "T" & Replace(Godzina_od.text, ":", vbNullString) & "00"
            Print #F, "DTEND:" & Format(DTPicker1.value, "YYYYMMDD") & _
                    "T" & Replace(Godzina_do.text, ":", vbNullString) & "00"
            Print #F, "SUMMARY: " & Trim(Temat.text)
            Print #F, "LOCATION: " & Trim(Sala.text)
            Print #F, "DESCRIPTION; ENCODING=QUOTED-PRINTABLE:" & _
                Replace(Info.text, xhr(13) & xhr(10), "=0D=0A=0D=0A") & "=0D=0A=0D=0A"
    If Przypomnienie_ustaw.value = True Then
                Print #F, "BEGIN: VALARM"
                Print #F, "TRIGGER:-PT" & Przypomnienie.text & "M"
                Print #F, "ACTION: Display"
    End If
            Print #F, "DESCRIPTION: Reminder"
            Print #F, "End: VALARM"
            Print #F, "End: VEVENT"
            Print #F, "End: VCALENDAR"
        Close #F

    If FileExists(strDestFolderPath) = True Then
        Dim olMail As MailItem
        olMail = Application.ActiveInspector.CurrentItem

        olMail.Attachments.Add(strDestFolderPath)
        olMail = Nothing
    End If
    Unload(Me)
End Sub
 
Przedstawiona powyżej wizja interfejsu może być rozbudowana np. o listę prowadzących, osadzenie wydarzenia w bazie danych serwera CRM lub inne, ważne dla przedsiębiorstwa elementy.
 
Podłączenie przypomnienia do emaila
Rys.2. Podłączenie przypomnienia do emaila.
 
Po uzupełnieniu pól występujących w interfejsie oraz potwierdzenia klawiszem wstaw zostaje dodany załącznik (Rys.2.), który to może być w każdej chwili otwarty i zapisany klawiszem „Zapisz i zamknij” w kalendarzu.
 
W przypadku braku działania kodu należy sprawdzić czy w systemie operacyjnym posiadamy wymaganą i zarejestrowaną bibliotekę obiektów „Microsoft Windows Common Controls 6.0 (SP6)„ Menu/Tools/References.
 
Program został sprawdzony i jest kompatybilny z wersjami 2000-2010.

MVP Shon Oskar – VBATools.pl
Jeśli masz pytania dot. tego artykułu zapraszam na Forum
Skonfiguruj swój pakiet dodatków do Excela, Worda, PowerPointa i Outlooka



© Wszelkie prawa zastrzeżone. Żadna część ani całość tego artykułu nie może być powielana ani publikowana bez zgody autora.