Outlook XP i drukowanie

Pytania, problemy, uwagi związane ze starszymi wersjami Microsoft Outlook 2003, 2002 (XP), 2000, 98

Moderator: Moderatorzy

Postprzez galble » Śr 27.09.2006 07:43

Tak wygląda w całości moje makro drukowania. Może komuś też się to przyda. Działa pod Outlook 2000:

Kod: Zaznacz cały
Sub PrintWithAttachList()
   
    Dim oMail As Object
   
    Set deleteFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderDeletedItems).Folders("kopie_wydruku") 'Folder dla kopi e-mail HTML
    Bialy
    For Each oMail In Application.ActiveExplorer.Selection
   
         Dim strList As String
         If oMail.Attachments.Count > 0 Then
            If oMail.GetInspector.EditorType = olEditorHTML Then
                oMail.Copy
                strList = "<b>Attachments:</b><br>"
                For nIndex = 1 To oMail.Attachments.Count
                    strList = strList & oMail.Attachments.Item(nIndex).DisplayName & "; "
                Next
                strList = "<br><br>" & strList & "<br>"
                oMail.HTMLBody = oMail.HTMLBody & strList
                oMail.Save
                oMail.Close 1
                oMail.PrintOut
                oMail.Move (deleteFolder)
                oMail.Display
            Else
                Set WshShell = CreateObject("WScript.Shell")
                WshShell.SendKeys ("^p~")'skrót CTRL+P i ENTER
            End If
         End If
         If oMail.Attachments.Count = 0 Then
            Set WshShell = CreateObject("WScript.Shell")
            WshShell.SendKeys ("^p~")
         End If
         Delay (7)
         Firmowy
    Next
 
End Sub

Function Bialy()
    Dim objNetwork, strLocal
    strLocal = "Nazwa drukarki"
    Set objNetwork = CreateObject("WScript.Network")
    objNetwork.SetDefaultPrinter strLocal
End Function

Function Kolor()
    Dim objNetwork, strLocal
    strLocal = "Nazwa drukarki "
    Set objNetwork = CreateObject("WScript.Network")
    objNetwork.SetDefaultPrinter strLocal
End Function

Public Sub Delay(ByVal Seconds As Long)
    'Opóźnienie zmiany drukarki na pierwotną
    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
galble
 
Posty: 38
Dołączył(a): Śr 06.09.2006 07:35

Postprzez galble » Śr 27.09.2006 07:49

Folder "kopie_wydruku" trzeba samemu utworzyć jako podfolder w Elementach usuniętych. Można też we właściowościach tego podfolderu uaktywnić Autoarchiwizację która będzie usuwała e-mail starsze niż 1 dzień. Dzięki michu za uwagę :)
galble
 
Posty: 38
Dołączył(a): Śr 06.09.2006 07:35

Postprzez michu » Cz 28.09.2006 20:57

Dzięki za tego posta! Naprawdę fajne makro.

Zrobiłbym w nim tylko kilka zmian kosmetyczno-wydajnościowych. Rozgałęzienie IF w funkcji PrintWithAttachList można trochę skrócić. Funkcje Biały, Kolor, Delay powinny być raczej zadeklarowane ze słowem kluczowym Private, aby w Outlook'u nie były widoczne jako osobne makra.

Kod wyglądałby w ten sposób:

Kod: Zaznacz cały
Sub PrintWithAttachList()
   
    Dim oMail As Object
   
    'Folder dla kopi e-mail HTML
    Set deleteFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderDeletedItems).Folders("kopie_wydruku")
    Call Bialy()
    For Each oMail In Application.ActiveExplorer.Selection
   
         Dim strList As String
         If oMail.Attachments.Count > 0 And oMail.GetInspector.EditorType = olEditorHTML Then
            oMail.Copy
            strList = "<b>Attachments:</b><br>"
            For nIndex = 1 To oMail.Attachments.Count
                strList = strList & oMail.Attachments.Item(nIndex).DisplayName & "; "
            Next
            strList = "<br><br>" & strList & "<br>"
            oMail.HTMLBody = oMail.HTMLBody & strList
            oMail.Save
            oMail.Close 1
            oMail.PrintOut
            oMail.Move (deleteFolder)
            oMail.Display
         Else
             Set WshShell = CreateObject("WScript.Shell")
             WshShell.SendKeys ("^p~")  'skrót CTRL+P i ENTER
         End If
    Next
   
    Delay (7)
    Call Firmowy()
 
End Sub

Private Function Bialy()
    Dim objNetwork, strLocal
    strLocal = "Nazwa drukarki"
    Set objNetwork = CreateObject("WScript.Network")
    objNetwork.SetDefaultPrinter strLocal
End Function

Private Function Kolor()
    Dim objNetwork, strLocal
    strLocal = "Nazwa drukarki "
    Set objNetwork = CreateObject("WScript.Network")
    objNetwork.SetDefaultPrinter strLocal
End Function

'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


Jest jeszcze tylko pytanie, co to za funkcja Firmowy()? Czy nie powinno tam być wywołania funkcji Kolor() do zmiany drukraki na poprzednią po zakończeniu drukowania? No i czy to wywołanie nie powinno być poza pęla FOR, tak jak w makrze powyżej?
Pozdrawiam
Michu
michu
 
Posty: 4190
Dołączył(a): N 05.02.2006 17:49
Lokalizacja: Jelenia Góra

Postprzez galble » Wt 03.10.2006 12:20

Tam gdzie jest Firmowy() to powinien być Kolor (). Dziękuję michu za poprawki i za wnikliwą uwagę :).
galble
 
Posty: 38
Dołączył(a): Śr 06.09.2006 07:35

Postprzez galble » Pn 16.10.2006 08:58

Chciałbym jeszcze rozszerzyć ten skrypt o funkcje drukowania zaznaczonego tekstu. Mam następujący pomysł (dotyczy wiadomości HTML):
Set WshShell = CreateObject("WScript.Shell")
WshShell.SendKeys ("^p") - otwiera okno drukowania
WshShell.SendKeys ("%z") - (ctrl+z) zaznacza opcje drukowania zaznaczonego tekstu
CTRL+z zostanie wykonane tylko wówczas jeśli jest zaznaczony tekst w message, a więc jest możliwość zautomatyzowania drukowania poprzez zrobienie odpowiedniej reguły poprawności. Problem polega na tym, że nie wiem jak odwołać się do poszczególnych controlek w oknie drukowania (ctrl+p). Proszę o pomoc.
galble
 
Posty: 38
Dołączył(a): Śr 06.09.2006 07:35

Postprzez michu » Pn 16.10.2006 12:39

Nie jest to proste zadanie, ponieważ do kontrolek dialogu drukowania nie dostaniesz się z poziomu Outlook'a. Do tego musisz użyć API Windows'a. W skrócie wygląda to tak, że po wyświetleniu okna drukowania powinieneś wylistować wszystkie okna w systemie w celu odnalezienia okienka drukowania. Potem musisz na nim wyszukać odpowiednie kontrolki i wysłać do nich odpowiednie komunikaty API, aby je zaznaczyć, czy kliknąć przycisk.

Inna kwestia to wykrycie, czy tekst w wiadomości w Outlook'u jest zaznaczony czy nie. Obiekty Outlook'a nie dostarczają takiej informacji.
Pozdrawiam
Michu
michu
 
Posty: 4190
Dołączył(a): N 05.02.2006 17:49
Lokalizacja: Jelenia Góra

Postprzez galble » Pn 16.10.2006 14:27

Skoro to nie jest takie proste to może prostrze będzie wykonanie reguły poprawności sprawdzającej czy tekst w message jezt zaznaczony? Jeśli TAK to wykonany zostanie skrót ctrl+z w przeciwnym wypadku wydrukuje cały dokument. Proszę o pomoc w tej sprawie.
galble
 
Posty: 38
Dołączył(a): Śr 06.09.2006 07:35

Postprzez michu » Pn 16.10.2006 15:00

No właśnie sprawdzenie, czy tekst w wiadomości jest zaznaczony to też jest problem. Nie widzę takiej możliwości.
Pozdrawiam
Michu
michu
 
Posty: 4190
Dołączył(a): N 05.02.2006 17:49
Lokalizacja: Jelenia Góra

Postprzez galble » Pt 10.11.2006 09:04

Powyższy skrypt drukowania umożliwia drukowanie wiadomości niezależnie od formatu (HTML, zwykły tekst, RTF) wraz z załącznikami. W OL2000 jest ograniczenie takie, że jeśli ktoś chce wydrukować zaznaczony tekst e-mail to musi on być w formacie HTML (inaczej trzeba zmienić format wiadomości. Poniższy skrypt umożliwia automatyczne formatowanie wszystkich przychodzących wiadomości na HTML.
W ThisOutlookSession umieszczamy kod:
Option Explicit

Private WithEvents olInboxItems As Items

Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.GetNamespace("MAPI")

Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set objNS = Nothing
End Sub
Private Sub olInboxItems_ItemAdd(ByVal item As Object)
Dim objReply As MailItem
If item.GetInspector.EditorType <> olEditorHTML Then
item.HTMLBody = Replace(item.Body, vbCrLf, "<br>")
item.Save
End If
Set objReply = item.Reply
Set item = Nothing

End Sub

Jest jednak problem. Skrypt "krzaczy się" podczas otrzymania Raportu przeczytania wiadomości. Należałoby wykluczyć ze skryptu nie tylko <>olEditorHTML ale również Raporty. Nie wiem tylko jaka odwołac się do tego. Proszę o pomoc.
galble
 
Posty: 38
Dołączył(a): Śr 06.09.2006 07:35

Postprzez michu » Pt 10.11.2006 09:44

A coś mówi dlaczego się wykrzacza?

Napisz sobie proste makro, które sprawdzi jakie są wartości właściwości "Class" i "MessageClass" dla takiego raportu. Być może na ich podstawie będzie można je identyfikować.
Pozdrawiam
Michu
michu
 
Posty: 4190
Dołączył(a): N 05.02.2006 17:49
Lokalizacja: Jelenia Góra

Postprzez galble » Pn 13.11.2006 08:32

To jest komunikat okna gdy VB sie krzaczy:
Run-time error '438':
Object doesen't support this property or method

Nie może zmienić formatu raportu na HTML. Szukam nadal rozwiazania jak w VB wykluczyć Raport. (Metoda sprawdzenia MessageClass = "IPM.Report" nie działa :()
galble
 
Posty: 38
Dołączył(a): Śr 06.09.2006 07:35

Postprzez michu » Pn 13.11.2006 09:24

A jak wygląda kod, w którym sprawdzasz czy to raport w MessageClass? Podaj jakiś dłuższy fragment.

Jeśli sprawdzasz to w warunku IF i używasz operatora AND to zauważ, że VB sprawdza oba warunki nawet jeśli pierwszy daje wartość FALSE (taki "nice feature").
Pozdrawiam
Michu
michu
 
Posty: 4190
Dołączył(a): N 05.02.2006 17:49
Lokalizacja: Jelenia Góra

Postprzez galble » Pn 13.11.2006 09:43

Zrobiłem warunek taki że wszystkie wiadomości muszą być Note i wówczas nastapi sprawdzenie następnego warunku i ewentualna zmiana formatu e-mail :( If Item.MessageClass = "IPM.Note" Then ...).
Już niby wszystko jest ok ale wyżuca mi kod na Set objReply = Item.Reply.



Option Explicit

Private WithEvents olInboxItems As Items

Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.GetNamespace("MAPI")

Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set objNS = Nothing
End Sub
Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
Dim objReply As MailItem
If Item.MessageClass = "IPM.Note" Then
If Item.GetInspector.EditorType = olEditorRTF Or olEditorText Then
Item.HTMLBody = Replace(Item.Body, vbCrLf, "<br>")
Item.Save
End If
End If
Set objReply = Item.Reply
Set Item = Nothing
galble
 
Posty: 38
Dołączył(a): Śr 06.09.2006 07:35

Postprzez galble » Pn 13.11.2006 09:57

galble napisał(a):Zrobiłem warunek taki że wszystkie wiadomości muszą być Note i wówczas nastapi sprawdzenie następnego warunku i ewentualna zmiana formatu e-mail :( If Item.MessageClass = "IPM.Note" Then ...).
Już niby wszystko jest ok ale wyżuca mi kod na Set objReply = Item.Reply.



Option Explicit

Private WithEvents olInboxItems As Items

Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.GetNamespace("MAPI")

Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set objNS = Nothing
End Sub
Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
Dim objReply As MailItem
If Item.MessageClass = "IPM.Note" Then
If Item.GetInspector.EditorType = olEditorRTF Or olEditorText Then
Item.HTMLBody = Replace(Item.Body, vbCrLf, "<br>")
Item.Save
End If
End If
Set objReply = Item.Reply
Set Item = Nothing


Zauwazyłem że na Raporcie kod nie jest wstanie wykonać Reply. A wiec szukam dalej rozwiązania.
galble
 
Posty: 38
Dołączył(a): Śr 06.09.2006 07:35

Postprzez galble » Pn 13.11.2006 10:17

Ok skrypt działa. Tzn posprawdzam jeszcze jak zachowa się podczas odbierania kilku e-mail o różnych formatach. W powyższym skrypcie przesunąłem poprostu tylko "End IF" na koniec. Logicznie odrazu powinienem tak zrobić.
galble
 
Posty: 38
Dołączył(a): Śr 06.09.2006 07:35

Postprzez michu » Pn 13.11.2006 21:52

Tak się dzisiaj akurat nadknąłem na report o dostarczonej/przeczytanej wiadomości. Ich "MessageClass" zaczyna się od "REPORT.IPM". Jeśli więc chcesz pomijać raporty o dostarczeniu/przeczytaniu powinieneś zrobić warunek:

Kod: Zaznacz cały
If Left( UCase(oItem.MessageClass), 10 ) <> "REPORT.IPM" Then
    ' Przetwarzaj wiadomość, która nie jest raportem
End If
Pozdrawiam
Michu
michu
 
Posty: 4190
Dołączył(a): N 05.02.2006 17:49
Lokalizacja: Jelenia Góra

Postprzez galble » Pt 19.01.2007 08:58

Odnośnie tego makra konwertującego przychodzące wiadomości na HTML mam problem z konwersją znaków z e-mail o formacie TEXT. Po konwersji na HTML polskie znaki nie są widoczne. Jest możlwiość poprawienia tego w makro? (Outlook 2000)

Kod: Zaznacz cały
Option Explicit

Private WithEvents olInboxItems As Items

Private Sub Application_Startup()
  Dim objNS As NameSpace
  Set objNS = Application.GetNamespace("MAPI")
 
  Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
  Set objNS = Nothing
End Sub
Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
On Error GoTo ErrorWindow
    Dim objReply As MailItem
    If Item.MessageClass = "IPM.Note" Then
    If Item.GetInspector.EditorType <> olEditorHTML Then
       Item.HTMLBody = Replace(Item.Body, vbCrLf, "<br>")
       Item.Save
    End If
   
    Set objReply = Item.Reply
    Set Item = Nothing
    End If
Exit Sub
ErrorWindow:
'msgbox"Błąd konwertowania"

End Sub
Ostatnio edytowano Wt 23.01.2007 15:46 przez galble, łącznie edytowano 3 razy
galble
 
Posty: 38
Dołączył(a): Śr 06.09.2006 07:35

Postprzez michu » Pt 19.01.2007 10:40

Gdyby to był Outlook nowszy niż 2000 można by próbować użyć właściwości BodyFormat, powinna załatwić cały problem. Niestety w Outlook 2000 jej nie ma i problem jest bardziej skomplikowany.

Przede wszystkim w HTMLBody powinieneś wstawiać cały dokument HTML, razem ze znacznikami <html>, <head>, <body>. Teraz ich w ogóle nie używasz i Outlook może trochę głupieć. W <head> powinieneś też zaznaczyć w jakim kodowaniu jest HTML używając znacznika:
Kod: Zaznacz cały
<META HTTP-EQUIV="Content-Type" content="text/html; charset=iso-8859-2">

Jeśli wszystkie wiadomości są w kodowaniu Europa Środkowa (ISO), to możesz zawsze pisać ten znacznik, jak powyżej. Jeśli jednak chcesz obsługiwać również inne wiadomości, to powienieneś najpierw sprawdzić w jakim kodowaniu jest wiadomość tekstowa. W tym celu możesz użyć właściwości InternetCodePage obiektu MailItem. Nie wiem, jakie dokładnie wartości ona zwraca dla różnych kodowań, więc będziesz musiał zrobić mały "research". Gdy już wiesz, w jakim kodowaniu jest wiadomość, wtedy możesz utworzyć z niej HTML, odpowiednio ustawić tag "Content-Type" i zapisać to wszystko do właściwości HTMLBody. Jaki będzie efekt, zagwarantować nie mogę, ale osobiście tak bym to robił.

PS. Taka prośba jest. Wygodniej byłoby czytać kod, gdybyś wklejał go w znacznik CODE, teraz trzeba się sporo namęczyć, żeby go rozszyfrować :)
Pozdrawiam
Michu
michu
 
Posty: 4190
Dołączył(a): N 05.02.2006 17:49
Lokalizacja: Jelenia Góra

Postprzez galble » Wt 23.01.2007 15:40

Mam problem z prawidłowym wyświelteniem znaków polskich. Nie mogę znaleźć rozwiązania. Proszę o pomoc.

Kod: Zaznacz cały
Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
    On Error GoTo ErrorWindow
    Dim objReply As MailItem
    Dim sBody, strHTML
    If Item.MessageClass = "IPM.Note" Then
    If Item.GetInspector.EditorType <> olEditorHTML Then
        sBody = Replace(Item.Body, vbCrLf, "<br>")
        strHTML = "<Html><Head>"
        strHTML = strHTML & "<meat http-equiv=" & "Content-Type " & _
        "content=" & Chr(34) & "text/html;" & " charset=" & "iso-8859-2"
        strHTML = strHTML & "</Head><Body>"
        strHTML = strHTML & sBody
        strHTML = strHTML & "</body></html>"
        Item.HTMLBody = strHTML
        Item.Save
    End If
    Set objReply = Item.Reply
    Set Item = Nothing
    End If
ErrorWindow:
End Sub
galble
 
Posty: 38
Dołączył(a): Śr 06.09.2006 07:35

Postprzez michu » Wt 23.01.2007 15:53

Tam ma być META, nie MEAT :) Poza tym brakuje znaków cudzysłowa. Fragment kodu wstawiający znacznik META powinien wyglądać tak:
Kod: Zaznacz cały
strHTML = strHTML & "<META HTTP-EQUIV=""Content-Type"" content=""text/html; charset=iso-8859-2"">"

Wszystko w jednej linii.
Pozdrawiam
Michu
michu
 
Posty: 4190
Dołączył(a): N 05.02.2006 17:49
Lokalizacja: Jelenia Góra

Poprzednia stronaNastępna strona

Powrót do Microsoft Outlook

Kto przegląda forum

Użytkownicy przeglądający ten dział: Brak zidentyfikowanych użytkowników i 8 gości

cron