Archiwizacja poczty, export do plików MSG
by vbatools on Nov.03, 2010, under Outlook, Porady
Przeraża was cykliczne wykonywanie kopii zapasowych lub nie wiecie, jakiej wersji Outlooka będziecie używać za kilka lat?
Na to pytanie niestety nikt nie zna odpowiedzi, sprawdzającej się w 100%, jednakże już dziś możecie wykonać pewien ruch, który was w pewien sposób zabezpieczy. Można dodać poniższe procedury, automatycznie eksportujące wiadomości do katalogu na dysk (bez względu, na to na jakie konto zostają one nadane czy z jakiego są odebrane*).
Dla poczty wychodzącej:
Umieszczamy wywołanie procedury w klasie “ThisOutlookSession”
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean) Call ExportOutcomingMailToFile(Item) End Sub
oraz umieszczamy poniższy kod w module:
Option Explicit Public Sub ExportOutcomingMailToFile(ByVal Item As Object) If Item.Class = 43 Then On Error Resume Next Dim strDestFolder$: strDestFolder = "c:\PostOut" 'jakakolwiek ścieżka Call MakeWholePath(strDestFolder) On Error GoTo 0 Dim strSubject$: strSubject = RemoveInvalidChar(Left(Item.Subject, 100)) Dim strDate$: strDate = Format(Item.CreationTime, "YYYY-DD-MM_HH-MM") Dim strFileName$: strFileName = strDate & " " & strSubject & ".msg" Item.SaveAs strDestFolder & strFileName, olMSG End If End Sub Public Function RemoveInvalidChar(str As String) Dim f& For f = 1 To Len(str) str = Replace(str, Mid$("/:?""<>|*", f, 1), vbNullString) Next str = Replace(str, vbTab, vbNullString) str = Replace(str, vbCrLf, vbNullString) RemoveInvalidChar = str End Function 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 Public 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
Dla poczty przychodzącej:
*można stworzyć regułę, którą swobodnie, selektywnie ograniczymy eksport w kreatorze przy pomocy tej procedury.
Sub ExportIncomingMailToFile(item As MailItem)
On Error Resume Next
Dim strDestFolder$: strDestFolder = "c:\PostIn" ' your any path
Call MakeWholePath(strDestFolder)
On Error GoTo 0
Dim strSubject$: strSubject = RemoveInvalidChar(Left(item.Subject, 100))
Dim strDate$: strDate = Format(item.CreationTime, "YYYY-DD-MM_HH-MM")
Dim strFileName$: strFileName = strDate & " " & strSubject & ".msg"
item.SaveAs strDestFolder & strFileName, olMSG
End Sub
Rys 1. Dodanie reguły exportu wiadomości do pliku msg.
Przytoczone w powyższych procedurach parametry można dowolnie edytować wykorzystując właściwości obiektu Mailitem, a dla poczty przychodzącej mamy do dyspozycji kreatora. Więcej na temat reguł i skryptów w tym artykule.
(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.
March 4th, 2011 on 13:29
dzięki za
Archiwizacja poczty, export do plików MSG
czegoś takiego szukałem od dawna. Super.
March 4th, 2011 on 14:45
Odnośnie twojego pytania.
Jeśli sprawdzisz kod to jest pobierana wartość utworzenia obiektu
Format(Item.CreationTime, "YYYY-DD-MM_HH-MM")
Wystarczy do niego dodać -SS a otrzymasz zapis w sekundach.
Metoda Drag’n’drop nadpisuje pliki i to makro jest naprawą błędu jakie powoduje utracenie wiadomości. Nie da się tego procesu poprawić (ponieważ nie jest przekazywany inny parametr poza tematem obiektu) to też korzystaj z pow kodu.
Jeśli masz inne pytania zapraszam na http://www.outlook.pl
OShon
March 4th, 2015 on 08:50
Skrypt działa poprawnie, jednak nie mogę poradzić sobie z moim problemem.
Mianowicie stworzyłem sobie konto mailowe, na które przychodzą wiadomości odebrane przekierowane z 20 innych kont. I tutaj chciałbym stworzyć skrypt, który tworzył by nazwe folderu na podstawie odbiorcy z maila który mi przekierowuje.
Czyli np. maile z kont: a1@bb.pl oraz a2@bb.pl są przekierowane na konto all@bb.pl i własnie skrypt na tym koncie all@bb.pl miałby tworzyć mi foldery o nazwie np. a1@bb.pl i a2@bb.pl i wrzucać do nich odpowiednio pliki MSG.
Jak wyciągnąć z MailItem informację o odbiorcach maili, których nazwa lub alias byłby równocześnie nazwą folderu??
March 4th, 2015 on 09:04
Chodzi o tworzenie katalogów na dysku, czy folderów poczty na podstawie emaili. Jeśli to drugie to pracę tą realizuje to rozwiązanie: http://vbatools.pl/przeniesienie-do-podfolderow/