ReplyAll | |
Mit diesem Addin für Outlook erhalten Sie in verschiedenen Situationen eine Warnung, bevor Sie auf eine Email versehentlich allen anderen Empfängern antworten. |
Dieses Beispiel bringt ausgesuchte Telefon- und Faxnummern in ein einheitliches Format: '+Ländercode (Ortsvorwahl) Anschlussnummer'. In der Funktion FormatPhonenumbers_Ex sehen Sie, welche Nummern behandelt werden (BusinessTelephoneNumber, BusinessFaxNumber etc.).
In der Funktion FormatPhonenumbers ganz oben steht m_DebugMode = True. Diese Einstellung bewirkt, dass die Originalnummern und das jeweilige Ergebnis der Formatierung nur ins Debug-Fenster (ctrl+g) ausgegeben werden. So können Sie in einem Testlauf kontrollieren, ob das Resultat korrekt ist. Wenn Sie die Zeile auf m_DebugMode = False ändern und die Funktion erneut ausführen, werden die Ãnderungen gespeichert.
In der Funktion ParseNumber gibt es die Konstante Def_CountryCode, die mit dem deutschen Ländercode voreingestellt ist. Wenn für eine Nummer der Ländercode fehlt, dann wird dieser Standardwert eingefügt. Tragen Sie hier bei Bedarf Ihren eigenen Ländercode ein.
Fügen Sie dem Outlook VBA-Projekt ein neues Modul hinzu und fügen Sie den ganzen Code ein. Aufrufen können Sie das z.B. über ALT+F8.
Private m_DebugMode As Boolean Public Sub FormatPhonenumbers() Dim coll As VBA.Collection Dim obj As Object Dim Contact As Outlook.ContactItem Dim IsInspector As Boolean 'Wenn True, wird die Ãnderungen nur ins Debug-Fenster geschrieben (ctrl+g) 'Wenn False, werden die Kontakte geändert und gespeichert m_DebugMode = True Set coll = GetCurrentItems(IsInspector) If coll.Count = 0 Then Exit Sub For Each obj In coll If TypeOf obj Is Outlook.ContactItem Then Set Contact = obj If m_DebugMode Then Debug.Print "--" & vbCrLf & Contact.FileAs End If FormatPhonenumbers_Ex Contact If m_DebugMode = False And IsInspector = False Then If Contact.Saved = False Then Contact.Save End If End If Next End Sub Private Sub FormatPhonenumbers_Ex(Contact As Outlook.ContactItem) Dim cc$, vw$, no$, OldNo$, NewNo$ Dim IsFax As Boolean OldNo = Contact.BusinessTelephoneNumber If Len(OldNo) Then ParseNumber OldNo, cc, vw, no, IsFax NewNo = JoinNumber(cc, vw, no, IsFax) If m_DebugMode Then Debug.Print OldNo: Debug.Print NewNo & vbCrLf ElseIf OldNo <> NewNo Then Contact.BusinessTelephoneNumber = NewNo End If End If OldNo = Contact.BusinessFaxNumber If Len(OldNo) Then ParseNumber OldNo, cc, vw, no, IsFax NewNo = JoinNumber(cc, vw, no, IsFax) If m_DebugMode Then Debug.Print OldNo: Debug.Print NewNo & vbCrLf ElseIf OldNo <> NewNo Then Contact.BusinessFaxNumber = NewNo End If End If OldNo = Contact.CompanyMainTelephoneNumber If Len(OldNo) Then ParseNumber OldNo, cc, vw, no, IsFax NewNo = JoinNumber(cc, vw, no, IsFax) If m_DebugMode Then Debug.Print OldNo: Debug.Print NewNo & vbCrLf ElseIf OldNo <> NewNo Then Contact.CompanyMainTelephoneNumber = NewNo End If End If OldNo = Contact.HomeTelephoneNumber If Len(OldNo) Then ParseNumber OldNo, cc, vw, no, IsFax NewNo = JoinNumber(cc, vw, no, IsFax) If m_DebugMode Then Debug.Print OldNo: Debug.Print NewNo & vbCrLf ElseIf OldNo <> NewNo Then Contact.HomeTelephoneNumber = NewNo End If End If OldNo = Contact.MobileTelephoneNumber If Len(OldNo) Then ParseNumber OldNo, cc, vw, no, IsFax NewNo = JoinNumber(cc, vw, no, IsFax) If m_DebugMode Then Debug.Print OldNo: Debug.Print NewNo & vbCrLf ElseIf OldNo <> NewNo Then Contact.MobileTelephoneNumber = NewNo End If End If End Sub Private Function JoinNumber(cc$, vw$, no$, IsFax As Boolean) As String Dim n$ If IsFax Then n = "Fax: " If Len(cc) Then n = n & cc If Len(vw) Then vw = " (" & vw & ") " n = n & vw n = n & no JoinNumber = n End Function Private Sub ParseNumber(ByVal Number$, cc$, vw$, no$, IsFax As Boolean) Dim p1&, p2& Dim i& Const Def_CountryCode As String = "+49" cc = "": vw = "": no = "" Number = Trim$(Number) If LCase$(Left$(Number, 4)) = "fax:" Then IsFax = True Number = Trim$(Mid$(Number, 5)) Else IsFax = False End If If Left$(Number, 2) = "00" Then Number = "+" & Mid$(Number, 3) If Left$(Number, 1) = "0" Then Number = Mid$(Number, 2) If Left$(Number, 1) <> "+" Then 'Assuming the country code is missing, insert the own country code. Number = Def_CountryCode & " " & Number End If Number = Replace(Number, "/", " ") Number = Replace(Number, "-", " ") Number = Replace(Number, "(0", "(") Number = Replace(Number, "(", " ") Number = Replace(Number, ")", " ") While InStr(Number, " ") > 0 Number = Replace(Number, " ", " ") Wend If Left$(Number, 1) = "+" Then For i = 2 To Len(Number) If IsNumeric(Mid$(Number, i, 1)) = False Then If p1 = 0 Then p1 = i ElseIf p2 = 0 Then p2 = i Else Exit For End If End If Next If p1 = 0 Then no = Number Else cc = Mid$(Number, 1, p1 - 1) If p2 Then vw = Mid$(Number, p1 + 1, p2 - p1 - 1) no = Mid$(Number, p2 + 1) Else no = Mid$(Number, p1) End If End If End If End Sub Private Function GetCurrentItems(Optional IsInspector As Boolean) As VBA.Collection Dim coll As VBA.Collection Dim Win As Object Dim Sel As Outlook.Selection Dim obj As Object Dim i& Set coll = New VBA.Collection Set Win = Application.ActiveWindow If TypeOf Win Is Outlook.Inspector Then IsInspector = True coll.add Win.CurrentItem Else IsInspector = False Set Sel = Win.Selection If Not Sel Is Nothing Then For i = 1 To Sel.Count coll.add Sel(i) Next End If End If Set GetCurrentItems = coll End Function
Reporter | |
Mit dem Reporter erstellen Sie Berichte für Ihre Outlook Daten. Mit wenigen Klicks werden Werte aus Aufgaben, Terminen und dem Journal summiert. |