Drukowanie zaznaczonego fragmentu wiadomości oraz listy załączników w Outlook 2000

Autor: galbe - użytkownik forum outlook.pl.

Zobacz wątek powiązany z makrem na forum outlook.pl.

 

W programie Microsoft Outlook w wersji 2000 podczas drukowania wiadomości HTML nie jest drukowana lista załączników. W wersjach programu Outlook powyżej 2002 została dodana taka funkcjonalność.

Użytkownicy Microsoft Outlook 2000 mogą skorzystać z poniższego makra w celu rozwiązania problemu. Makro umożliwia drukowanie e-mail i:

• w wiadomościach HTML dodaje informacje o załącznikach,
• w wiadomościach HTML, gdy jest zaznaczony tekst - drukuje tylko zaznaczenie , dodając informacje o załącznikach, jeśli są (tworzony jest nowy e-mail),
• w wiadomościach TEXT, gdy jest zaznaczony tekst - drukuje tylko zaznaczenie, dodając informacje o załącznikach, jeśli są (tworzony jest nowy e-mail).

Wymagania:

• włączenie biblioteki "Microsoft Forms 2.0 Object Library",
• utworzenie folderu o nazwie "kopie_wydruku" w obszarze "Zadania" (przechowywane są tam przerobione przez makro e-mail - można ustawić dla tego katalogu Autoarchiwizacja: usuwaj elementy starsze niż 1 dni, skasuj stare elementy)

W projekcie VBA, w pozycji ThisOutlookSession należy wpisać kod:

Private Sub Application_Startup()
End Sub

Ten wpis ma za zadanie tylko uaktywnić aplikację Microsoft Visual Basic. Bez tej aktywacji, występują problemy w działaniu makra, podczas "świeżo" uruchomionego Outlooka 2000 - trzeba zamknąć i otworzyć ponownie e-mail którego chce się wydrukować (przy dłuższym działaniu aplikacji Outlook nie ma problemu).

 

 Sub PrintWithAttachList()
    On Error GoTo ErrorWindow
    Dim oMail As Outlook.MailItem
    Dim drukuj, kopiuj, wklej, edytuj As CommandBarButton
    Dim MyData As New msforms.DataObject

    oMail = Application.ActiveWindow.CurrentItem
    drukuj = Application.ActiveWindow.CommandBars.FindControl(, 4)
    kopiuj = Application.ActiveWindow.CommandBars.FindControl(, 19)
    wklej = Application.ActiveWindow.CommandBars.FindControl(, 22)
    edytuj = Application.ActiveWindow.CommandBars.FindControl(, 5604)

    'Folder dla kopi e-mail
    deletefolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderTasks).Folders("kopie_wydruku")

    Dim strList As String
    '##################### HTML ###################################
    If oMail.Attachments.Count > 0 And oMail.GetInspector.EditorType = olEditorHTML Then ' gdy są załączniki

        If kopiuj.Enabled = False Then      ' brak zaznaczenia tekstu,obiektu
            oMail.Copy()                                ' kopia e-mail
            strList = "<b>Attachments:</b><br>"
            For nIndex = 1 To oMail.Attachments.Count
                strList = strList & oMail.Attachments.Item(nIndex).DisplayName & "; "  ' lista załączników
            Next
            strList = strList & "<br><br>"
            oMail.HTMLBody = strList & oMail.HTMLBody  ' treść wiadomości HTML
            oMail.Close(olSave)                ' zamknięcie e-mail z zapisem
            oMail.Move(deletefolder)     ' przeniesienie do folderu
            oMail.Display()                        ' wyświetlenie e-mail
            Delay(1)                              ' opóźnienie
            drukuj.Execute()                     ' drukowanie
        Else                                        ' gdy zaznaczony jest obszar wiadomości
            kopiuj.Execute()                      ' wykonanie opcji kopiuj - do schowka
            oMail.Copy()
            strList = "<b>Attachments:</b><br>"
            For nIndex = 1 To oMail.Attachments.Count
                strList = strList & oMail.Attachments.Item(nIndex).DisplayName & "; "
            Next
            strList = strList & "<br><br>"
            oMail.HTMLBody = " "         ' wyczyszczenie HTMLBody
            edytuj.Execute()                  ' właczenie opcji edytowania wiadomości
            Delay(2)
            wklej.Execute()                   ' wklejenie zawartości schowka
            oMail.HTMLBody = strList & oMail.HTMLBody  ' dodanie listy załączników
            oMail.Close(olSave)
            oMail.Move(deletefolder)
            oMail.Display()
            Delay(1)
            drukuj.Execute()                   ' drukowanie
        End If
        'gdy nie ma załączników
    ElseIf oMail.Attachments.Count = 0 And oMail.GetInspector.EditorType = olEditorHTML Then
        If kopiuj.Enabled = False Then ' gdy nie jest zaznaczony tekst
            drukuj.Execute()
        Else        ' gdy jest zaznaczony tekst
            kopiuj.Execute()
            oMail.Copy()
            oMail.HTMLBody = " "    ' wyczyszczenie HTMLBody
            edytuj.Execute()
            Delay(2)
            wklej.Execute()
            oMail.Close(olSave)
            oMail.Move(deletefolder)
            oMail.Display()
            Delay(1)
            drukuj.Execute()
        End If
    End If
    ' ####################### KONIEC HTML #######################################

    ' ####################### TEXT ##############################################
    If oMail.GetInspector.EditorType <> olEditorHTML Then
        If kopiuj.Enabled = False Then ' gdy nie jest zaznaczony tekst (niektywna opcja kopiowania)
            drukuj.Execute()
        Else                        ' gdy jest zaznaczony tekst
            kopiuj.Execute()
            oMail.Copy()
            For nIndex = 1 To oMail.Attachments.Count  ' usuwanie załączników
                strList = strList & oMail.Attachments.Item(nIndex).DisplayName & "; " ' lista załączników
                oMail.Attachments.Remove(1)
            Next
            MyData.GetFromClipboard()         ' odwołanie do schowka
            If strList = Empty Then              ' sprawdzenie czy w e-mail są załączniki
                oMail.Body = MyData.GetText  ' przypisanie obiektowi Body tekstu ze schowka
            Else ' gdy są załączniki
                oMail.Body = "Attachments: " & strList & XXX(10) & XXX(10) & MyData.GetText
            End If
            drukuj.Execute()
            oMail.Close(olSave)                 ' zamknięcie z zapisem
            oMail.Move(deletefolder)
            oMail.Display()
        End If
    End If
    ' ################## KONIEC TEXT #############################################
    deletefolder = Nothing
    kopiuj = Nothing
    edytuk = Nothing
    wklej = Nothing
    drukuj = Nothing
    Exit Sub
ErrorWindow:
    MsgBox("Błąd drukowania. Spróbuj wydrukować poprzez Plik/Drukuj..!", vbCritical)
End Sub

'Opóźnienie
Private Sub Delay(ByVal Seconds As Long)
    Dim Start As Long
    Dim Finish As Long

    On Error Resume Next

    Start = Timer
    Finish = Start + Seconds
    While (Start < Finish)
        Start = Timer
        DoEvents()
    End While
End Sub


 

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