Excel Forum - Porady, Pomoc,  Excel Help, Excel FAQ Strona Główna
 FAQ  RegulaminRegulamin  Szukaj   Użytkownicy   Grupy   Rejestracja   Profil   Twoje wiadomości   Zaloguj 


Poprzedni temat «» Następny temat
ID tematu: 59700 Skopiuj do schowka Outlook 2010 - raporty przeczytania
Autor Wiadomość
OShon 
Excel Expert



Zaproszone osoby: 380
Pomógł: 1603 razy
Posty: 8136
Wysłany: 13-12-2017, 21:02   

No to pierwsze koty za płoty, choć mam wrażenie że nie czerpiesz inspiracji z podpowiedzi tylko idziesz swoją drogą.

Twój kod nie sprawdza czy Outlook jest włączony i otwierasz nowa instancję. Też może być choć szkoda bo kod działa wolniej. Nie badasz który obiekt jest powiadomieniem tylko sprawdzasz po treści tematu, ok twoja sprawa choć podałem to chyba czytelnie.

ok lecimy dalej
Kod:
Debug.Print fld.Parent.Name

lub fld.FolderPath powie ci w jakim folderze jesteś (i będziesz w domyślnym).
A wiec inny folder nie będzie już default
Kod:
Set fld = ns.Folders("nazwa_konta").Folders("skrzynka odbiorcza")


Masz to wytłumaczone tutaj: Przenoszenie wielkich maili do archiwum
Niemniej jednak zapraszam na takie dyskusje na Outlook.pl
EOT
_________________
Oskar Shon - MVP Office System/Development 11/19r, 3x MCC
Forum moderator: Outlook.pl | ExcelForum.pl | MSDN dział VBA
Sprawdź promocje na polskie dodatki do MS Office w VBATools.pl
ID posta: 336072 Skopiuj do schowka
 
 
Marti 
ExcelGaduła 500+



Pomógł: 98 razy
Posty: 905
Wysłany: 13-12-2017, 21:42   

Poprawiłem ;-)

Kod:
Sub sprawdz_raporty()
Dim OutApp As Object
Dim ns As Object
Dim fld As Object
Dim item As Object
Dim oMail As Outlook.MailItem
Dim fold As Object

If OutApp Is Nothing Then
Set OutApp = CreateObject("Outlook.application")
Else:
Set OutApp = GetObject(, "Outlook.Application")
End If

Set ns = OutApp.GetNamespace("MAPI")
Set fld = ns.GetDefaultFolder(olFolderInbox)
'Set fld = ns.Folders("nazwa_konta").Folders("skrzynka odbiorcza")

For Each item In fld.Items
  If item.Class = 46 And item.UnRead = True Then
    If item Like "*Przeczytane: Problem ID *" & id_problemu Then
    Debug.Print item.Subject
    Debug.Print Format(item.ReceivedTime, "YYYY-MM-DD HH:MM")
    Debug.Print item.SenderEmailAddress
    Debug.Print item.To
    Else
    End If
  Else
  End If
Next

Set OutApp = Nothing
End Sub


Jutro zaraz z rańca przetestuję w pracy :-)
_________________
Najlepszym dowodem na to, że w kosmosie istnieje inteligencja, jest to, że się z nami nie kontaktują.
ID posta: 336075 Skopiuj do schowka
 
 
Marti 
ExcelGaduła 500+



Pomógł: 98 razy
Posty: 905
Wysłany: 14-12-2017, 11:05   

Przedstawiam końcowe dzieło, które działa tak jak sobie to wymarzyłem na początku :-)

Kod:
Sub sprawdz_raporty()
Dim OutApp As Object
Dim ns As Object
Dim fld As Object
Dim item As Object
Dim oMail As Outlook.MailItem
Dim fold As Object

raport_przeczytania = ""

If OutApp Is Nothing Then
Set OutApp = CreateObject("Outlook.Application")
Else:
Set OutApp = GetObject(, "Outlook.Application")
End If

Set ns = OutApp.GetNamespace("MAPI")
Set fld = ns.Folders("alarmy_hp").Folders("Skrzynka odbiorcza")

For i = fld.Items.Count To 1 Step -1

    With fld.Items(i)
        If .Class = 46 And .UnRead = True Then
            If .CreationTime > data_monitu Then
                If .Subject Like "*Problem ID:*" & id_problemu Then
                raport_przeczytania = Format(.CreationTime, "YYYY-MM-DD HH:MM")
                Exit For
                Else
                End If
            Else
            End If
        Else
        End If
    End With
Next

Set OutApp = Nothing
End Sub


Odwróciłem pętlę, aby było jeszcze szybciej i zaczynała się od najświeższych wiadomości, sprawdzam tylko nieprzeczytane i takie, których data otrzymania raportu jest większa od daty wysłanego wcześniej monitu (bo takich tych samych monitów może być kilka).
.ReceivedTime odnosi się tylko do obiektów .Class = 43 a więc musiałem znaleźć odpowiednik dla obiektów .Class = 46 czyli .CreationTime.

OShon, dziękuję jak zwykle za pomoc bez której nie osiągnąłbym tego rozwiązania. Trudna jest ta nasza współpraca ;-) , ale bardzo owocna :beer
_________________
Najlepszym dowodem na to, że w kosmosie istnieje inteligencja, jest to, że się z nami nie kontaktują.
ID posta: 336110 Skopiuj do schowka
 
 
OShon 
Excel Expert



Zaproszone osoby: 380
Pomógł: 1603 razy
Posty: 8136
Wysłany: 14-12-2017, 12:47   

Oczywiście że trudna. Siedzę w tym już dość długo i sam cieszę się jak dziecko mogąc wpaść na rozwiązanie sam. Czasami jednak człowiek się zatnie, co jest zrozumiałe i bez podpowiedzi nie ruszy z miejsca. To też jestem zagorzałym zwolennikiem podpowiedzi zamiast pisania za kogoś gotowca. Bo ani ja nie jestem pracownikiem pytającego, ani ilość satysfakcji z samorealizowania się na tym polu jest znikoma. Po co mam się spalać tracąc czas dla osoby która tego nie doceni. Wklei kod i przy następnym problemie znowu będzie liczyć na pomoc. Podpowiedź to inna sprawa, jeśli trafna daje mi również satysfakcje, a pytający zaczyna myśleć przy tym co robi, co rokuje na przyszłość. Także zawsze możesz na mnie liczyć (dzięki za słowa uznania), ale przeważane wskaże ci w jakim stawie łowić lub podam inny przykład aby pomyśleć nad jego zmianą.

Co do pow:
Kod:
If OutApp Is Nothing Then
Set OutApp = CreateObject("Outlook.Application")
Else:
Set OutApp = GetObject(, "Outlook.Application")
End If

Else nigdy nie zachodzi, OutApp zawsze jest Nothing, bo wcześniej nie przypisałeś do zmiennej nic. Popraw, bo cały warunek nic nie zmienia - ale kierunek właściwy. Właczaj Breaking pointa aby sprawdzać jak się kod zachowuje podczas jego tworzenia. (o dwukropku nie wspomnę)...

Po drugie. Jeśli opierasz się na referencjach do kontrolki Outlooka, to też możesz skorzystać z intelisense (czyli podpowiedzi parametrów obiektów). Możesz tak zadeklarować zmienne:
Kod:
Dim OutApp As Outlook.Application
Dim ns As Outlook.Namespace
Dim fld As Outlook.Folder
Dim item As Object 'Outlook.ReportItem

Oczywiście ta ostatnia jest skomentowana, bo nie każdy obiekt w folderze to zwrot z serwera a na przykład wiadomość, ale możesz sobie na chwile odkomentować aby sprawdzić czym dysponuje ten raport i co możesz wyprowadzić do Excela. Jak kod będzie działał możesz przejść na późne wiązanie.

Jeśli chodzi jak odróżniać obiekty, zwłaszcza z późnym wiązaniu to oto spis klas i ich numery respektowane w takim kodzie.
_________________
Oskar Shon - MVP Office System/Development 11/19r, 3x MCC
Forum moderator: Outlook.pl | ExcelForum.pl | MSDN dział VBA
Sprawdź promocje na polskie dodatki do MS Office w VBATools.pl
ID posta: 336125 Skopiuj do schowka
 
 
Marti 
ExcelGaduła 500+



Pomógł: 98 razy
Posty: 905
Wysłany: 14-12-2017, 14:03   

OShon napisał/a:
Else nigdy nie zachodzi, OutApp zawsze jest Nothing, bo wcześniej nie przypisałeś do zmiennej nic. Popraw, bo cały warunek nic nie zmienia - ale kierunek właściwy


Kod:
Set OutApp = GetObject(, "Outlook.Application")
If OutApp Is Nothing Then
Set OutApp = CreateObject("Outlook.Application")
Else
End If


Teraz lepiej? ;-)
_________________
Najlepszym dowodem na to, że w kosmosie istnieje inteligencja, jest to, że się z nami nie kontaktują.
ID posta: 336145 Skopiuj do schowka
 
 
OShon 
Excel Expert



Zaproszone osoby: 380
Pomógł: 1603 razy
Posty: 8136
Wysłany: 14-12-2017, 14:22   

Tak bezpieczniej:
Kod:
On Error Resume Next
Set OutApp = GetObject(, "Outlook.Application")
If OutApp Is Nothing Then _
Set OutApp = CreateObject("Outlook.application")
On Error GoTo 0
_________________
Oskar Shon - MVP Office System/Development 11/19r, 3x MCC
Forum moderator: Outlook.pl | ExcelForum.pl | MSDN dział VBA
Sprawdź promocje na polskie dodatki do MS Office w VBATools.pl
ID posta: 336148 Skopiuj do schowka
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Nie możesz załączać plików na tym forum
Możesz ściągać załączniki na tym forum
Dodaj temat do Ulubionych
Wersja do druku

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group
Theme xandgreen created by spleen& Programosy modified v0.3 by warna
Opieka techniczna www.marketingNET.pl

Archiwum

Strona używa plików cookies.

Kliknij tutaj, żeby dowiedzieć się jaki jest cel używania cookies oraz jak zmienić ustawienia cookie w przeglądarce.
Korzystając ze strony użytkownik wyraża zgodę na używanie plików cookies, zgodnie z bieżącymi ustawieniami przeglądarki.
Sprawdź, w jaki sposób przetwarzamy dane osobowe