VBATools

Zapis przychodzących wiadomości do pliku TXT za pomoca reguły

by on Mar.14, 2011, under Outlook, Porady

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 = MakeWholePath("C:\Temp\email")
 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

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 Joanna Subik
Profile picture of Karol Stilger
Profile picture of Anorak
Profile picture of marcinmachalowski
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