Automatyzacja 2 - Wyszukanie danych w wiadomości Outlooka i dopisanie do pliku aplikacji Excel
tagi: analiza, dane, Excel, Exchange, format tabularyczny, IMAP, Outlook
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
© Wszelkie prawa zastrzeżone. Żadna część ani całość tego artykułu nie może być powielana ani publikowana bez zgody autora.