Pobranie kodów tekstowych z wiadomości
by vbatools on Sep.02, 2011, under Outlook, Porady
Wyobraźcie sobie wiadomości pocztowe, w których nasz adresat umieszcza kody produktów, łańcuchy danych, zapisane pomiędzy dwoma nawisami (w przykładzie użyte “<” i “>” ). Na nas, jako operatora, są to dane jakie musimy przechwycić i umieścić w bazie danych, pliku TXT, Excel, bądź innej.
Nasz zainteresowany (pytanie pochodzi z ExcelForum.pl) chciał aby pobieranie nastąpiło tylko dla zaznaczonych wiadomości w folderze.
Oto rozwiązanie zadania:
Sub Pobierz_kody_z_maila() 'MVP OShon from VBATools.pl Dim omail As MailItem, item, x&, y&, el As Variant Dim tabela As New Collection, tablica As Variant For Each omail In Application.ActiveExplorer.Selection Set item = omail tablica = Split(item.Body, "<") For x = LBound(tablica) To UBound(tablica) If InStr(1, tablica(x), ">") > 0 Then tabela.Add CStr(Split(tablica(x), ">")(0)) End If Next x Next omail Dim plik$: plik = "C:\temp\Plik_KODY.txt" '<-zapis danych Call MakeWholePath(plik) If tabela.Count = 0 Then MsgBox "W zaznaczonych wiadomościach nie znaleziono żadnego kodu!", vbExclamation, "UWAGA" If FileExists(plik) = True Then Kill plik GoTo koniec End If Dim F&: F = FreeFile Open plik For Output As #F For Each el In tabela Print #F, el Next el Close #F koniec: Set omail = Nothing MsgBox "Kody zostały wyeksportowane do " & plik, vbInformation, "VBATools.pl" End Sub Public Function FileExists(FilePath As String) As Boolean On Error GoTo blad FileExists = Len(Dir(FilePath, vbDirectory Or vbHidden Or vbSystem)) > 0 Exit Function blad: FileExists = False End Function Private Sub MakeWholePath(FileWithPath As String) 'MVP OShon from VBATools.pl Dim x&, PathToMake$ For x = LBound(Split(FileWithPath, "\")) To UBound(Split(FileWithPath, "\")) - 1 PathToMake = PathToMake & "\" & Split(FileWithPath, "\")(x) If Right$(PathToMake, 1) <> ":" Then If FileExists(Mid(PathToMake, 2, Len(PathToMake))) = False Then _ MkDir Mid(PathToMake, 2, Len(PathToMake)) End If Next End Sub
Można przyjąć możliwość przebudowy i zamiany procedury na formułę, albo na wyrażenia regularne ..ale to już inny temat.
(c) Shon Oskar – www.VBATools.pl
Wszelkie prawa zastrzeżone. Żadna część ani całość tego artykułu nie może być powielana ani publikowana bez zgody autora.