W tym artykule zostanie przedstawiony mechanizm pozwalający zaprezentować automatyzacje aplikacji Microsoft, na przykładzie Outlook i Excel w praktyce. Przykładem będzie obróbka wiadomości, która jest raportem wykonanej usługi przez firmę taksówkową. Kluczowym pytanie w tym przypadku jest odszukanie właściciela karty, na które konto zostało nałożone obciążenie. W niej można zauważyć numer VIP 93217. W tym przykładzie będziemy chcieli dowiedzieć się, do kogo on należy, modyfikując wiadomość email.
Rys 1. Widok wiadomości, co do której będzie wykonana automatyzacja
Oprócz przedstawionej powyżej wiadomości (Rys1) potrzebna jest lista, będąca materiałem źródłowym, dzięki której uzupełnimy naszą wiadomość wyszukując dane. W niej zapisane będą słowa klucze, które będziemy wyszukiwać, a następnie zwrócimy wartość znajdującą się obok, która tłumaczy w tym przypadku przyporządkowaną wartość. Pokazany poniżej rysunek tłumaczy alokacje danych w pliku Excela:
Rys 2. Źródłowa baza danych
Dla zachowania poufności dane, które nie są konieczne w tej prezentacji zostały zamazane.
Procedura VBA, która będzie umieszczona w środowisku Developerskim otworzy ten plik (Rys2) oraz pobierze do tablicy wszystkie jego elementy, po czym zamknie plik w tle. Następnie po spełnieniu warunku (odnalezienie słowa klucza) i wyszukaniu interesującej dla nas wartości (numeru karty taksówkowej) w pliku xls, zwróci do zmiennej nazwisko jej posiadacza. Jeśli zwrócimy uwagę na wiadomość możemy dowolnie zlokalizować miejsce, w którym zwrócimy wyszukane dane. W pow. przypadku będzie to linia ze znakami „--”. W zależności od naszych potrzeb miejsce to może być dobrane dowolnie. Mechanizm zamieni tą wartość na wyszukaną i doda naszą linię ze znakami, co wywoła wrażenie dodania extra linii.
Rys 3. Wiadomość poddana modyfikacji.
Kod zawiera dwie procedury. Pierwsza z nich to mechanizm testujący, którym możemy odwołać się do otwartej lub zaznaczonej wiadomości.
Sub Przetestuj_modyfikacje_raportu_email()
'MVP OShon from VBATools.pl
Dim MyItem As MailItem
On Error Resume Next
Select Case TypeName(Application.ActiveWindow)
Case "Explorer"
Set MyItem = ActiveExplorer.Selection.Item(1)
MyItem.Display
Case "Inspector": Set MyItem = ActiveInspector.CurrentItem
Case Else: Exit Sub
End Select
On Error GoTo 0
If MyItem Is Nothing Then
MsgBox "Wpierw wskarz lub otwórz wiadomość " & _
"która jest raportem Taxi!", vbExclamation, "VBATools.pl"
GoTo koniec
End If
Call Wyszukaj_excel_wpisz_w_tresc(MyItem)
koniec:
Beep
Set MyItem = Nothing
End Sub
Sub Wyszukaj_excel_wpisz_w_tresc(Item As Outlook.MailItem)
'MVP OShon from VBATools.pl
Const baza$ = "c:\temp\Barbakan_lista_regula.xlsx"
Const klucz$ = "VIP: "
Const info$ = "Znaleziono w bazie jako: "
Const wstaw_w$ = "--"
Dim Nr_Karty_Taxi&, Znaleziony$
If Item <> olMailItem = False Then Exit Sub
With Item
If InStr(1, .Body, klucz) > 0 Then
If InStr(1, .Body, info) > 0 Then Exit Sub
Nr_Karty_Taxi = Split(Split(.Body, klucz)(1), ",")(0)
Else
Exit Sub
End If
End With
Dim xlApp As Object, xlWkb As Object, xlWks As Object, tablica(), x&, max_row&
If FileExists(baza) = False Then Exit Sub
ponownie:
If IsFileOpen(baza) = True Then
MsgBox "Wyjdź z pliku bazy i spróbuj ponownie." & vbCr & _
"Baza: " & baza, vbInformation, "VBATools.pl"
GoTo ponownie:
End If
Set xlApp = CreateObject("Excel.Application")
With xlApp
.Visible = False
Set xlWkb = .Workbooks.Open(baza)
Set xlWks = xlWkb.Sheets(1)
End With
With xlWks
max_row = .Cells(.Rows.Count, "a").End(xlUp).Row
tablica = .Range("a1:b" & max_row).value
End With
xlWkb.Close False
xlApp.Quit
Set xlWkb = Nothing
Set xlWks = Nothing
Set xlApp = Nothing
For x = 1 To max_row
If tablica(x, 1) = Nr_Karty_Taxi Then Znaleziony = tablica(x, 2): Exit For
Next x
If Len(Znaleziony) = 0 Then Znaleziony = "Brak w bazie" Else _
Znaleziony = info & Znaleziony
With Item
If .BodyFormat = olFormatHTML Then
.HTMLBody = Replace(.HTMLBody, wstaw_w, Znaleziony & "<br>" & wstaw_w & "<br>")
Else
.Body = Replace(.Body, wstaw_w, Znaleziony & vbNewLine & wstaw_w & vbNewLine)
End If
.Save
End With
End Sub
Public Function FileExists(FilePath$) As Boolean
On Error GoTo blad
FileExists = Len(Dir(FilePath, vbDirectory Or vbHidden Or vbSystem)) > 0
Exit Function
blad:
FileExists = False
End Function
Public Function IsFileOpen(FileName$) As Boolean
Dim iFilenum&, iErr&
On Error Resume Next
iFilenum = FreeFile()
Open FileName For Input Lock Read As #iFilenum
Close iFilenum
iErr = Err
On Error GoTo 0
Select Case iErr
Case 0: IsFileOpen = False
Case 70: IsFileOpen = True
Case Else: Error iErr
End Select
End Function
Procedurę umieszczamy w module [Alt+F11]/Menu/Insert/Module a następnie zapisujemy nasz projekt.
Aby zautomatyzować w pełni ten proces (nie wywoływać go dla każdej wiadomości z osobna) wystarczy procedurę „Wyszukaj_excel_wpisz_w_tresc” dodać, jako skrypt w regule wiadomości przychodzących. Cyklicznie przychodzący raport wykonania usługi zostanie przerobiony automatycznie w identyczny sposób jak wywołany ręcznie.
Rys 4. Podłączenie procedury do reguły MS Outlook
Zapisujemy regułę pod unikalną nazwą i to wszystko.
Sposób ten działa w przypadku użytkowania konta POP3, ponieważ w konfiguracji IMAP/Exchange modyfikacja wiadomości nie jest dopuszczalna. Aby jednak uporać się z tym zadaniem polecam odniesienie się do następnego artykułu: Automatyzacja2, w którym zostanie opisany proces eksportu danych z aplikacji Outlook do Excela.
MVP Shon Oskar – VBATools.pl
Jeśli masz pytania dot. tego artykułu zapraszam na Forum
Skonfiguruj swój pakiet dodatków do Excela, Worda, PowerPointa i Outlooka
© Wszelkie prawa zastrzeżone. Żadna część ani całość tego artykułu nie może być powielana ani publikowana bez zgody autora.