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:
Wymagania:
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
Set oMail = Application.ActiveWindow.CurrentItem
Set drukuj = Application.ActiveWindow.CommandBars.FindControl(, 4)
Set kopiuj = Application.ActiveWindow.CommandBars.FindControl(, 19)
Set wklej = Application.ActiveWindow.CommandBars.FindControl(, 22)
Set edytuj = Application.ActiveWindow.CommandBars.FindControl(, 5604)
'Folder dla kopi e-mail
Set 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 & Chr(10) & Chr(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 #############################################
Set deletefolder = Nothing
Set kopiuj = Nothing
Set edytuk = Nothing
Set wklej = Nothing
Set 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
Wend
End Sub