VBATools

Pobranie kodów tekstowych z wiadomości

by 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.

:, , , ,

Leave a Reply

Recently Active Members

Profile picture of vbatools
Profile picture of Karol Stilger
Profile picture of marcinmachalowski
Profile picture of Joanna Subik
Profile picture of Anorak
Profile picture of programistaaccess
Profile picture of piotrpawlik
Profile picture of Emil Wasilewski
Profile picture of kicekpicek
Profile picture of coldfusion
Profile picture of Gosia Borzęcka
Profile picture of lukaszch
Profile picture of itadministracja
Profile picture of farbenia
Profile picture of Łukasz Kałużny
Profile picture of kabzinski
Profile picture of rtynski
Profile picture of leszekbetlinski
Profile picture of Iv
Profile picture of Justyna Spychała