Listing 12.1. Procedura VBA, która wysyła wiadomość e-mail, gdy Outlook uruchamia przypomnienie
Private Sub Application_Reminder(ByVal Item As Object)
Dim msg As MailItem
'
' Tworzenie nowej wiadomości
'
Set msg = Application.CreateItem(olMailItem)
'
' Stwórz wiadomość ze swoim adresem i tematem przypomnienia
'
msg.To = "twojadres@domena.pl"
msg.Subject = Item.Subject
msg.Body = "Reminder!" & vbCrLf & vbCrLf
'
' Stwórz treść wiadomości korzystając z charakterystycznych właściwości różnych typów przypomnień
'
Select Case Item.Class
Case olAppointment
msg.Body = "Appointment Reminder!" & vbCrLf & vbCrLf & _
"Start: " & Item.Start & vbCrLf & _
"End: " & Item.End & vbCrLf & _
"Location: " & Item.Location & vbCrLf & _
"Appointment Details: " & vbCrLf & Item.Body
Case olContact
msg.Body = "Contact Reminder!" & vbCrLf & vbCrLf & _
"Contact: " & Item.FullName & vbCrLf & _
"Company: " & Item.CompanyName & vbCrLf & _
"Phone: " & Item.BusinessTelephoneNumber & vbCrLf & _
"E-mail: " & Item.Email1Address & vbCrLf & _
"Contact Details: " & vbCrLf & Item.Body
Case olMail
msg.Body = "Message Reminder!" & vbCrLf & vbCrLf & _
"Sender: " & Item.SenderName & vbCrLf & _
"E-mail: " & Item.SenderEmailAddress & vbCrLf & _
"Due: " & Item.FlagDueBy & vbCrLf & _
"Flag: " & Item.FlagRequest & vbCrLf & _
"Message Body: " & vbCrLf & Item.Body
Case olTask
msg.Body = "Task Reminder!" & vbCrLf & vbCrLf & _
"Due: " & Item.DueDate & vbCrLf & _
"Status: " & Item.Status & vbCrLf & _
"Task Details: " & vbCrLf & Item.Body
End Select
'
' Wyślij wiadomość
'
msg.Send
'
' Uwolnij obiekt msg
'
Set msg = Nothing
End Sub
Listing 12.2. Program obsługi wydarzenia dla ItemSend, które pyta użytkownika o zapisanie wychodzącej wiadomości do folderu „Elementy wysłane”
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim nResult As Integer
'
' Wyświetlanie zapytania
'
nResult = MsgBox("Save this message in Sent Items?", vbSystemModal + vbYesNoCancel)
'
' Sprawdzanie rezultatu
'
If nResult = vbCancel Then
Cancel = True
End If
If nResult = vbNo Then
'
' Jeśli użytkownik kliknął Nie, nie zapisuj wiadomości w folderze Elementy wysłane
'
Item.DeleteAfterSubmit = True
End If
End Sub
Private WithEvents myExplorer As Explorer
'
' Umieść to stwierdzenie w programie obsługującym zdarzenie Application_Startup (zobacz --> rysunek [Author:T] 12.16)
'
Listing 12.3. Program obsługi wydarzenia, pytający użytkownika o hasło przed przejściem do „poufnego” foldera
Private Sub myExplorer_BeforeFolderSwitch(ByVal NewFolder As Object,Cancel As Boolean)
Dim pwd as String
'
' Czy przechodzimy do foldera: „poufne”?
'
If NewFolder.Name = "Poufne" Then
'
' Jeśli tak, zapytaj użytkownika o hasło
'
pwd = InputBox("Proszę wpisz hasło dla tego foldera:")
'
' Sprawdzanie hasła
'
If pwd <> "password" Then
'
' Jeśli hasło jest niepoprawne, anuluj przejście do foldera
'
Cancel = True
End If
End If
End Sub
2 Część I ♦ Podstawy obsługi systemu WhizBang (Nagłówek strony)
2 Dokument2
[KM] w oryginale Listing, ale chyba chodziło o rysunek , bo przecież nie ma listingu 12.16