VBA Tools

Outlook radzi sobie z prezentacją załączonych do wiadomości plików. Jednakże, co dzieje się, kiedy plik załącznika jest zapisywany w Outlook a następnie wysyłany do adresata? Co dzieje się, kiedy tendencyjnie obrabiany jest jeden plik?

Co prawda prawidłowo jest zapisać plik przed obróbką na dysku w przeznaczonym do tego katalogu a następnie dokonać modyfikacji poza klientem poczty (mamy wtedy kontrolę nam plikiem), jednakże praktyka, która jest przedmiotem artykułu jest dość często spotykana. Outlook podczas otwierania i modyfikacji pliku nie zapisuje go wprost w Outlook.pst, ale w katalogu tymczasowym. Taki proces jest bezkolizyjny, gdy użytkownik sporadycznie realizuje tę czynność (zwłaszcza na różnych plikach). Jeśli plików w katalogu jest wiele to Outlook tworzy sobie nowy katalog.

Proces oczyszczania dysku nie opróżnia nam plików z tych katalogów, pomimo tego, iż kopia tych samych plików została umieszczona w „Wysłanych elementach”, co czyni nasz dysk i system bardziej obciążony. Usunięcie pliku z wiadomości powinno usunąć również plik w katalogu na naszym dysku, jednak czasem nie jest to realizowane. Usunięcie zaś pliku z katalogu nie kasuje kopii tego pliku z wiadomości Outlook.

Co więcej, podczas obróbki dużej ilości tak samo nazywających się plików może dość do przepełnienia. Polega to na tym, iż kopia tak samo nazywających się plików przekracza 99. W tym momencie Outlook nie pozwala nam umieścić w wiadomości pocztowej nowego załącznika o identycznej jak poprzednio nazwie.

Poniższa procedura „Kasowanie_plikow_tymczasowych” jest opracowana z myślą o czyszczeniu plików we wszystkich katalogach tymczasowych Outlooka.

Option Explicit
Declare Function SHGetSpecialFolderLocation Lib "Shell32.dll" _
 (ByVal hwndOwner As Long, ByVal nFolder As Long, _
 pidl As ITEMIDLIST) As Long

Declare Function SHGetPathFromIDList Lib "Shell32.dll" _
 Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
 ByVal pszPath As String) As Long

Public Type SH_ITEMID
 cb As Long
 abID As Byte
End Type

Public Type ITEMIDLIST
 mkid As SH_ITEMID
End Type

Public Declare Function SetFileAttributes Lib "kernel32" _
Alias "SetFileAttributesA" (ByVal lpFileName As String, _
ByVal dwFileAttributes As Long) As Long
Dim mclsFormChanger As CFormChanger

Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const MAX_PATH As Integer = 260

Private Function fGetSpecialFolder(CSIDL As Long) As String
 Dim sPath As String
 Dim IDL As ITEMIDLIST
 fGetSpecialFolder = ""
 If SHGetSpecialFolderLocation(0, CSIDL, IDL) = 0 Then
 sPath = Space$(MAX_PATH)
 If SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal sPath) Then
 fGetSpecialFolder = Left$(sPath, InStr(sPath, vbNullChar) - 1) & "\"
 End If
 End If
End Function

Public Sub Kasowanie_plikow_tymczasowych()
Dim MyArray(300) As String, i&, file_name$, path$
file_name = Dir$(fGetSpecialFolder(32) & "Content.Outlook" & "\*.*", vbDirectory)
i = 0
Do While (Len(file_name) > 0) And (i < 101)
 MyArray(i) = file_name
 i = i + 1
 file_name = Dir$()
Loop
For i = 1 To UBound(MyArray)
 If Len(MyArray(i)) > 0 And MyArray(i) <> ".." Then
 path = CStr(fGetSpecialFolder(32) & "Content.Outlook\" & MyArray(i))
 Call MakeMeArchive(path)
 On Error GoTo ErrMess
 Kill path & "\*.*"
 End If
Next i
Exit Sub
ErrMess:
MsgBox Err.Description, vbExclamation, "O'Shon VBATools.pl"
End Sub

Private Sub MakeMeArchive(path$)
Dim fso As Object, fsoFile As Variant, ile&
Set fso = CreateObject("Scripting.FileSystemObject")
 For Each fsoFile In fso.GetFolder(path).Files
 SetFileAttributes fsoFile, FILE_ATTRIBUTE_ARCHIVE
 Next fsoFile
End Sub

Aby osadzić procedurę „Kasowanie_plikow_tymczasowych” pod przyciskiem w menu MS Outlook, polecam uwadze ten artykuł.

(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.