Automatyzacja 1 - Wyszukanie danych w Excelu i uzupełnienie wiadomości Outlook.

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