Automatyzacja 2 - Wyszukanie danych w wiadomości Outlooka i dopisanie do pliku aplikacji Excel

W tej prezentacji posłużymy się tym samym przykładem, co zaprezentowanym w „Automatyzacja 1”, z tym że informacje, jakie nas interesują, zostaną przekazane do pliku Excela a nie uzupełnione o dodatkową treść. W tym pliku umieszczone zostaną informacje z każdej wiadomości w formacie tabularycznym (linia po linii), tak aby można było przystąpić do analizy tych danych. Ten sposób jest preferowany w przypadku posiadania kont IMAP/Exchange z uwagi na brak możliwości modyfikacji wiadomości.

Poniższe zdjęcie przedstawia znaną już nam wiadomość raportu za wykonaną usługę przejazdu taksówką.

Rys 1. Widok wiadomości, z danymi do przekazania.

W powyższej wiadomości interesują nas pola, które określają szczegóły zamówienia. W tej linii znajdują się wszystkie dane potrzebne do analizy. Podobnie jak poprzednio przygotowana zostanie procedura testowa, która sprawdzi czy pobrane dane będą zgodne z naszymi oczekiwaniami (pocięte i sklasyfikowane). Następnie otworzymy plik bazy (lub go utworzymy, o ile nie istnieje on w danej lokalizacji) i dodamy kolejno ww. dane. W tym przypadku nie musimy sięgać do bazy danych osób, ponieważ informacje na ten temat możemy wyszukać formułą pomiędzy plikami Excela wyszukaj.pionowo(), lub od razu dodać pole z taką formułą określając miejsce przechowywania pliku źródłowego.

Na pow. zdjęciu wiadomości email możemy zauważyć strategiczne dane, które będą stanowiły kolumny zestawienia. Mogą to być pobrane z dolnego poziomu wiadomości: „Data:”, „Woz:”, „Kwota:”, „Rachunek:”, trasa składająca się z 2 linijek „skąd/dokąd” oraz z górnych wierszy „hasło o numerze”, który w tym przypadku definiuje nr karty usługobiorcy. Dla urozmaicenia, kod zawierać będzie procedurę, dzięki której pobrane zostaną wszystkie rekordy z aktywnego folderu, aby nie analizować, jak poprzednio, pojedynczej wiadomość. Jednakże nie będzie ona wydajna z uwagi na regułę, która podpiętą, jako skrypt do wiadomości przychodzących będzie realizowała dodanie nowego rekordu do zestawienia (za każdym razem, odebrania wiadomości spełniającej zakładany warunek); zgodnie z rys 4 poprzedniego artykułu. To ona „Wyszukaj_tresc_wpisz_w_excel”, będzie otwierała i zamykała z zapisem plik Excelowy po jego uzupełnieniu o dodatkowy rekord.

Option Explicit

Sub Pobieranie_danych_email()
'MVP OShon from VBATools.pl
Dim MyItem As MailItem, el As Object
Dim oFolder As MAPIFolder, ile&
Set oFolder = Application.ActiveExplorer.CurrentFolder
On Error GoTo blad
For Each el In oFolder.Items
    If el.Class = 43 Then
        Set MyItem = el
        If MyItem.Subject = "Powiadomienie z systemu Monitor VIP" Then
            ile = ile + 1
            Call Wyszukaj_tresc_wpisz_w_excel(MyItem)
        End If
    End If
Next el
MsgBox "Przerobiono " & ile & " wiadomości z " & _
            oFolder.Items.Count, vbInformation, "VBATools.pl"
koniec:
Set MyItem = Nothing
Exit Sub
blad:
    MsgBox "Błąd: " & Err.Number & vbCr & Err.Description, _
        vbCritical, "Informacja o błędzie"
End Sub

Sub Wyszukaj_tresc_wpisz_w_excel(Item As Outlook.MailItem)
'MVP OShon from VBATools.pl
Const baza$ = "c:\temp\Barbakan_raport_regula.xlsx"
Dim Haslo&, Auto%, Data As Date, Kwota As Double, NrRachunku&
Dim Skad$, Dokad$
If Item <> olMailItem = False Then Exit Sub
With Item
    Data = Split(Split(.Body, "Data: ")(1), ",")(0)
    Haslo = Split(Split(.Body, "hasło o numerze ")(1), ",")(0)
    Auto = Split(Split(.Body, "Woz: ")(1), ",")(0)
    Kwota = Split(Split(.Body, "Kwota: ")(1), " zl,")(0)
    NrRachunku = Split(Split(.Body, "Rachunek: ")(1), ",")(0)
    Skad = Split(Split(.Body, "Skąd: ")(1), vbCrLf)(0)
    Dokad = Split(Split(.Body, "Dokąd: ")(1), vbCrLf)(0)
End With

Dim xlApp As Object, xlWkb As Object, xlWks As Object, x&, max_row&
Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = False
If FileExists(baza) = False Then
    Set xlWkb = xlApp.Workbooks.Add
        xlWkb.SaveAs FileName:=baza
Else
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
   
    With xlApp
        .Visible = False
    Set xlWkb = .Workbooks.Open(baza)
    End With
End If
Set xlWks = xlWkb.Sheets(1)
With xlWks
    max_row = .Cells(.Rows.Count, "a").End(3).Row 'xlUp    

If max_row = 1 And Len(.Cells(1, 1)) = 0 Then
        With .Cells(1, 1)
            .value = "Data przejazdu"
            .Offset(, 1) = "Numer"
            .Offset(, 2) = "Samochód"
            .Offset(, 3) = "Kwota"
            .Offset(, 4) = "nrRachunku"
            .Offset(, 5) = "Skąd/Dokąd"
        End With
    End If
    With .Cells(max_row + 1, 1)
        .value = Data
        .Offset(, 1) = Haslo
        .Offset(, 2) = Auto
        .Offset(, 3) = Kwota
        .Offset(, 4) = NrRachunku
        .Offset(, 5) = Skad & " -> " & Dokad
    End With
End With
    xlWkb.Close True
    xlApp.Quit
Set xlWkb = Nothing
Set xlWks = Nothing
Set xlApp = Nothing
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

 
Rys 2. Przygotowana baza po exporcie danych z wiadomości email.

 Teraz pozostaje jedynie skonfigurować regułę z pow. umieszczonym skryptem.
 

Na tych dwóch przykładach pokazana jest automatyzacja procesów, jaka może usprawnić proces w dowolnej firmie korzystającej z poczty elektronicznej i stałych raportów działań. Wystarczy tylko opierać się o dane, jakie będą mogły być wyodrębnione i przekazane do zestawienia bądź wiadomości elektronicznej.

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