Rufnummer vergrößert anzeigen
Nicht alle Anwender haben ein Telefon mit einer Tapi-Schnittstelle, um aus Outlook® heraus wählen zu können. Steht das Telefon nicht nahe am PC, wird es mit dem Lesen von Rufnummern schwierig.
Mit dem hier gezeigten Programmierbeispiel werden die üblichen Rufnummer des aktuellen Kontakts relativ groß in einer HTML-E-Mail angezeigt.
Zur Verwendung dieses Beispiels beachten Sie bitte die wichtigen Hinweise, sowie den Workshop VBA in Outlook® verwenden. Den Code bitte in ein neues Modul kopieren (Einfügen -> Modul im VBA-Editor).
Ab Outlook® 2002
Option Explicit Public Sub ShowPhoneNumber() '===================================================================== ' Zeigt eine Rufnummer groß in einer E-Mail an ' (c) Peter Marchert - http://www.outlook-stuff.com ' 2008-12-18 - Version 1.0.0 '===================================================================== Dim objTrash As Outlook.MAPIFolder Dim objContact As Outlook.ContactItem Dim objMail As Outlook.MailItem Dim strNumber As String '--------------------------------------------------------------------- ' Hier wird die E-Mail formatiert '--------------------------------------------------------------------- Const HTMLCODE As String = _ "<p style=""font-family: Arial Black; font-size: 2cm; " & _ "text-align: center; color: red; font-weight: bold"">%</p>" '--------------------------------------------------------------------- ' Fehlerbehandlung wegen Set-Anweisungen ausschalten '--------------------------------------------------------------------- On Error Resume Next '--------------------------------------------------------------------- ' Aktuell geöffnetes Element refernzieren '--------------------------------------------------------------------- Set objContact = Outlook.ActiveInspector.CurrentItem '--------------------------------------------------------------------- ' Wenn kein Element geöffnet ist, dann markiertes verwenden '--------------------------------------------------------------------- If objContact Is Nothing Then Set objContact = Outlook.ActiveExplorer.Selection(1) '--------------------------------------------------------------------- ' Auch nichts markiert? '--------------------------------------------------------------------- If objContact Is Nothing Then Exit Sub '--------------------------------------------------------------------- ' Rufnummer(n) ermitteln '--------------------------------------------------------------------- If Trim(objContact.BusinessTelephoneNumber) <> "" Then strNumber = "Ges.: " & Trim(objContact.BusinessTelephoneNumber) End If If Trim(objContact.HomeTelephoneNumber) <> "" Then strNumber = strNumber & "<br />" & "Priv.: " & Trim(objContact.HomeTelephoneNumber) End If If Trim(objContact.MobileTelephoneNumber) <> "" Then strNumber = strNumber & "<br />" & "Mob.: " & Trim(objContact.MobileTelephoneNumber) End If If Trim(objContact.BusinessFaxNumber) <> "" Then strNumber = strNumber & "<br />" & "Fax g.: " & Trim(objContact.BusinessFaxNumber) End If If Trim(objContact.HomeFaxNumber) <> "" Then strNumber = strNumber & "<br />" & "Fax p.: " & Trim(objContact.HomeFaxNumber) End If '--------------------------------------------------------------------- ' Keine Rufnummer gefunden? '--------------------------------------------------------------------- If strNumber = "" Then MsgBox "Im Kontakt """ & objContact.Subject & """ wurden keine" & _ vbCrLf & "üblichen Rufnummern gefunden." _ , vbCritical + vbOKOnly, "Rufnummer anzeigen" Set objContact = Nothing Exit Sub End If '--------------------------------------------------------------------- ' Ordner "Gelöschte Objekte" referenzieren '--------------------------------------------------------------------- Set objTrash = Outlook.Session.GetDefaultFolder(olFolderDeletedItems) '--------------------------------------------------------------------- ' Neue E-Mail im Ordner "Gelöschte Objekte" erstellen '--------------------------------------------------------------------- Set objMail = objTrash.Items.Add(olMailItem) '--------------------------------------------------------------------- ' E-Mail formatieren und anzeigen '--------------------------------------------------------------------- With objMail .BodyFormat = olFormatHTML .HTMLBody = Replace(HTMLCODE, "%", strNumber) .Save .Display End With '--------------------------------------------------------------------- ' Clean Up '--------------------------------------------------------------------- Set objMail = Nothing Set objContact = Nothing Set objTrash = Nothing End Sub