VBA Tools

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łę ..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.