Microsoft Visual Basic for Applications ''Odebrane''.pdf

(2383 KB) Pobierz
ThisOutlookSession - 1
' (*1) - tu okre l nazw foldera, do którego maj by zapisywane wiadomo ci
' (*2) - je li zapisujesz wiadomo ci ze skrzynki odbiorczej to u yj tej linii kodu
' (*3) - je li zapisujesz wiadomo ci z folderu "Elementy wysøane", to u yj tej linii kodu. Do nazwy
pliku wstawiany jest tylko adres pierwszego odbiorcy.
' Nazwa makra to "SaveItems". "RemoveInvalidChars" to funkcja pomocnicza, która usuwa nieprawidøowe
znaki z nazwy pliku.
Sub Wyslane()
On Error Resume Next
' (*1) Docelowy folder na dysku
Dim strDestFolder: strDestFolder = "c:\Andrzej Nowak - Dokumenty wøasne\Temp - Poczta wysøana\"
' Set fso = CreateObject("Scripting.FileSystemObject")
' fso.CreateFolder strDestFolder
For Each mail In Application.ActiveExplorer.Selection
Dim strSubject: strSubject = RemoveInvalidChars(Left(mail.Subject, 100))
Dim strDate: strDate = RemoveInvalidChars(mail.SentOn)
'Dim strSender: strSender = RemoveInvalidChars(mail.SenderEmailAddress)
i odebranych
'(*2) - dla wiadomo c
Dim strSender: strSender = RemoveInvalidChars(mail.Recipients(1).Address) '(*3) - dla wiadomo c
i wysøanych
Dim strFileName: strFileName = strDate & " - " & strSender & " - " & strSubject & ".msg"
mail.SaveAs strDestFolder & strFileName, olMSG
Next
End Sub
Sub Odebrane()
On Error Resume Next
' (*1) Docelowy folder na dysku
Dim strDestFolder: strDestFolder = "c:\Andrzej Nowak - Dokumenty wøasne\Temp - Poczta odebrana\
' Set fso = CreateObject("Scripting.FileSystemObject")
' fso.CreateFolder strDestFolder
For Each mail In Application.ActiveExplorer.Selection
Dim strSubject: strSubject = RemoveInvalidChars(Left(mail.Subject, 100))
Dim strDate: strDate = RemoveInvalidChars(mail.SentOn)
Dim strSender: strSender = RemoveInvalidChars(mail.SenderEmailAddress)
'(*2) - dla wiadomo ci
odebranych
'Dim strSender: strSender = RemoveInvalidChars(mail.Recipients(1).Address) '(*3) - dla wiad
omo ci wysøanych
Dim strFileName: strFileName = strDate & " - " & strSender & " - " & strSubject & ".msg"
mail.SaveAs strDestFolder & strFileName, olMSG
Next
End Sub
' Usu nieprawidøowe znaki ze cie ki pliku
Private Function RemoveInvalidChars(str)
str
str
str
str
str
str
str
str
str
str
=
=
=
=
=
=
=
=
=
=
Replace(str,
Replace(str,
Replace(str,
Replace(str,
Replace(str,
Replace(str,
Replace(str,
Replace(str,
Replace(str,
Replace(str,
"\", "")
"/", "")
":", "")
"*", "")
"?", "")
"""", "")
">", "")
"<", "")
"|", "")
"O=NORDZUCKEROU=OPALENICACN=RECIPIENTSCN=", "")
"
ThisOutlookSession - 2
str
str
str
str
str
str
=
=
=
=
=
=
Replace(str,
Replace(str,
Replace(str,
Replace(str,
Replace(str,
Replace(str,
"O=NORDZUCKEROU=Chelmzacn=Recipientscn=", "")
"O=NORDZUCKEROU=Hauptverwaltungcn=Systemcn=", "")
"O=NORDZUCKEROU=CHELMZACN=RECIPIENTSCN=", "")
"O=NORDZUCKEROU=HAUPTVERWALTUNGCN=RECIPIENTSCN=", "")
vbTab, "")
vbCrLf, "")
For i = 1 To Len(str)
If Mid(str, i, 1) < " " Then
str = Left(str, i - 1) & "_" & Mid(str, i + 1)
End If
Next
RemoveInvalidChars = str
End Function

Plik z chomika:

Inne pliki z tego folderu:

Inne foldery tego chomika:

Zgłoś jeśli naruszono regulamin