VBATools

Jeden z forumowiczów chciał zapisywać każdą przychodzącą wiadomość jako odrębny plik TXT na swoim dysku. Można to nazwać pewną formą archiwizacji lub metodą na pozyskanie danych do późniejszej obróbki pozyskiwanych przez klienta pocztowego.

Pozwolę sobie przedstawić rozwiązanie, które najłatwiej realizuje się poprzez ustawienie reguły z podłączonym poniższym skryptem.

Sub SaveMyMsg(MyMail As MailItem)
'MVP OShon from VBATools.pl
 Dim fso As Object 'FileSystemObject
 Dim strID$, strFolderPath$, strSaveName$
 Dim olNS As Outlook.NameSpace
 Dim oMail As Outlook.MailItem

 strID = MyMail.EntryID
 Set olNS = Application.GetNamespace("MAPI")
 Set oMail = olNS.GetItemFromID(strID)
 strFolderPath = "C:\Temp\email"
 Call MakeWholePath(strFolderPath)
 strSaveName = "Wiadomosc.txt" & Format(Now, "YYYY-MM-DD_HH-MM") & ".txt"
 Set fso = CreateObject("Scripting.FileSystemObject")

 If fso.FileExists(strFolderPath & strSaveName) Then
    fso.DeleteFile strFolderPath & strSaveName
 End If

 oMail.SaveAs strFolderPath & strSaveName, olTXT

 Set oMail = Nothing
 Set olNS = Nothing
 Set fso = Nothing
End Sub

Private 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)
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 sparametryzować nazwę pliku dodając do jego nazwy temat wiadomości, nazwę nadawcy czy inne parametry lub ograniczyć wprost w regule. Wywołanie kodu można przetestować zaznaczając obiekt i uruchamiając tą procedurę:

Sub Test_for_selected_msg()
Call SaveMyMsg(Application.ActiveExplorer.Selection.item(1))
End Sub

W pow. artykule zastosowano dwie metody na sprawdzenie folderów. Już wiecie jakie?

Należy pamiętać iż po osadzeniu kodu w developerze VBA Outlooka, procedurę SaveMyMsg należy podpiąć jako skrypt w kreatorze reguł.

(c) Shon Oskar – www.VBATools.pl