Kategorie szkoleń | Egzaminy | Kontakt
  • 1
  • 0
  • 1

Potrzebuję regułę/kod VBA, który pozwoli zapisać wiadomość/tytuł wiadomości (Outlook) do pliku Excel/na dysk. W kodzie muszę również zawrzeć warunki: wiadomości z daną frazą w tytule. Możemy ustalić, że będzie to "zamówienie". 

Chciałbym, aby każdy mail o treści "zamówienie XYZ", który otrzymam będzie zapisany (tylko tytuł) do pliku Excel, bądź (druga alternatywa) zapisze całą wiadomość na dysk. 

Czy taki kod/reguła jest możliwa? Od czego zacząć? 

Tobiasz_Kusch_5elj
  • Zapytał
  • @ Tobiasz_Kusch_5elj | 21.01.2020
    • 0
    • 0
    • 0

Odpowiedź (1)

  • 1

Zdarzenie związane z otrzymaniem nowej wiadomości możesz obsłużyć poniższym makrem (wklej je do modułu ThisOutlookSession). Niestety problematyczna może być wydajność tego rozwiązania, bo za każdym razem otwierany jest Excel (teoretycznie można zapisywać wiadomości do csv, co powinno znacznie przyspieszyć całą operację).

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)

Set msg = Application.GetNamespace("MAPI").GetItemFromID(EntryIDCollection)

If InStr(LCase(msg.Subject), "zamówienie") > 0 Then
   If MsgBox("Pojawiło się nowe zamówienie, zapisać?" & String(2, vbCrLf) & msg.Sender & vbCrLf & msg.Subject & vbCrLf & msg.Body, vbQuestion + vbOKCancel) = vbCancel Then Exit Sub
   
   Set xl = CreateObject("excel.application")
   xl.Visible = True
   
   With xl.workbooks.Open("C:\maile.xlsx")
      With .worksheets("Arkusz1")
         Set rng = .cells(.rows.Count, 1).End(-4162).Offset(1, 0)
      End With
      
      rng.Value = msg.Sender
      rng.Offset(0, 1).Value = msg.Subject
      rng.Offset(0, 2).Value = msg.Body
      
      .Close savechanges:=True
   End With
   
   xl.Quit
   Set xl = Nothing
End If

Set msg = Nothing

MsgBox "Mail zapisany.", vbInformation

End Sub

Polecam jednak skorzystać z dodatku Power Query, bo tam jest to bajecznie proste - całość to dosłownie kilka kliknięć w menu, a ściągnięcie nowych danych, to kwestia odświeżenia tabeli wynikowej:

let
    Źródło = Exchange.Contents("adres@firma.pl"),
    Mail1 = Źródło{[Name="Mail"]}[Data],
    #"Przefiltrowano wiersze" = Table.SelectRows(Mail1, each [Folder Path] = "\Inbox\" and Text.Contains([Subject], "zamówienie"))
    #"Usunięto inne kolumny" = Table.SelectColumns(#"Przefiltrowano wiersze",{"Subject", "Sender", "Preview"}),
    #"Rozwinięty element Sender" = Table.ExpandRecordColumn(#"Usunięto inne kolumny", "Sender", {"Name", "Address"}, {"Sender.Name", "Sender.Address"})
in
    #"Rozwinięty element Sender"

 

 
Mirosław_Janiak
  • Odpowiedział
  • @ Mirosław_Janiak | 21.01.2020
    • 1
    • 7
    • 1
Komentarze
Dostałem powiadomienie o komentarzu, ale go nie widzę... Na wszelki wypadek odpowiem :) Makro nie tworzy nowego skoroszytu (choć nie problem dodać taką opcję), tylko zakłada dopisywanie danych do istniejącego pliku w konkretnym arkuszu - czyli musi istnieć "C:\maile.xlsx" z arkuszem "Arkusz1". Założyłem też, że w pierwszym wierszu istnieją tam nagłówki kolumn, więc przy czystym arkuszu makro zrzuci dane do drugiego wiersza. Można wtedy albo dopisać nagłówki, albo usunąć pusty pierwszy wiersz, dalej będzie już ok :)
Skomentował : @ Mirosław_Janiak ,23.01.2020
  • 1
  • 7
  • 1