VBA: Selektierte Kontakte filtern

[ravage]

Moin,

ich hab da mal wieder ein Problem.

Erst mal zum Grund meines Programms:

Ein Kontakt in Outlook 2003 mit einer E-Mail Adresse und einer FAX Nummer taucht im Outlook Adressbuch 2 mal auf. Einmal mit der E-Mail Adresse, einmal mit der FAX Nummer. Jetzt haben einige User bei uns wohl schon mehrmals eine E-Mail an die FAX Nummer geschickt, weil sie den falschen Eintrag aus dem Adressbuch gewählt haben. Einer dieser User ist jetzt an mich heran getreten und hat um eine Lösung gebeten, die FAX Nummern aus dem Adressbuch zu entfernen.

Nach kurzer Recherche im Internet (Google ist dein Freund) bin ich auf die Lösung gekommen, einfach vor die FAX Nummer etwas ins Feld zu schreiben. Sprich, man macht aus "+49 1234 567890" einfach ein "FAX +49 1234 567890", und schon ist die FAX Nummer aus dem Adressbuch verschwunden. Da die Jungs und Mädels hier aber recht viele Kontakte haben, hab ich ein VBA Script geschrieben, was mir das ändern der FAX Nummer abnimmt.

Hier erst mal das Script:

Sub SetFAX()
Dim msg As Outlook.ContactItem
Dim fax As String

For Each msg In Application.ActiveExplorer.Selection

fax = msg.BusinessFaxNumber
If (Len(fax)) Then
If (InStr(1, fax, "FAX", 1)) Then
Else
msg.BusinessFaxNumber = "FAX " & fax
msg.Save
End If
End If

fax = msg.HomeFaxNumber
If (Len(fax)) Then
If (InStr(1, fax, "FAX", 1)) Then
Else
msg.HomeFaxNumber = "FAX " & fax
msg.Save
End If
End If

fax = msg.OtherFaxNumber
If (Len(fax)) Then
If (InStr(1, fax, "FAX", 1)) Then
Else
msg.OtherFaxNumber = "FAX " & fax
msg.Save
End If
End If

Next msg
End SubVorgehensweise: Der User öffnet seine Kontakte und markiert alle User die er gerne umgewandelt haben möchte. Danach ruft er das obrige Makro SetFAX() auf. Das Makro durchläuft alle markierten Kontakte, prüft ob eine geschäftliche, private oder sonstige Fax Nummer eingetragen ist, und schreibt, wenn nicht schon vorhanden, ein "FAX " davor.

Das funktioniert soweit auch ganz gut. Jetzt zu meinem Problem:

Wenn der User jetzt nicht nur Kontakte sondern auch Verteilerlisten markiert und das Makro startet, kommt die Fehlermeldung "Typen unverträglich" was ja auch logisch ist. Denn Verteilerlisten sind keine Kontakte ;)

Ich möchte jetzt gerne die Selektion vorher filtern und nur die Kontakte übernehmen und auswerten. Ich weiss nur absolut nicht wie ich das anstellen soll.

Es müsste vor der Zeile "For Each msg In Application.ActiveExplorer.Selection" geprüft werden ob in der Selection nur Kontakte (olContact) oder auch Verteilerlisten gespeichert sind.

Hilfe :)

[ravage]

Ok das Problem hat sich beim Tippen des Eintrags schon selbst erledigt. Ich bin einen etwas anderen Weg gegangen, indem ich den User einen Kontakte Ordner auswählen lasse, in dem alle Kontakte bearbeitet werden. Dort kann ich auch die Verteilerlisten Filtern. Hier der Quellcode, falls jemand was damit anfangen kann:

Sub SetFAX_new()
Dim nspMapi As Outlook.NameSpace
Dim folMapi As Outlook.MAPIFolder
Dim itmReal As Outlook.Items
Dim msg As Outlook.ContactItem

Set nspMapi = Application.GetNamespace("MAPI")
Set folMapi = nspMapi.PickFolder
Set itmAll = folMapi.Items

'Verteilerlisten herausfiltern,
'nur 'Richtige Kontakte' verwenden
strContactFilter = "[MessageClass] = 'IPM.Contact'"
Set itmReal = itmAll.Restrict(strContactFilter)

For Each msg In itmReal

fax = msg.BusinessFaxNumber
If (Len(fax)) Then
If (InStr(1, fax, "FAX", 1)) Then
Else
msg.BusinessFaxNumber = "FAX " & fax
msg.Save
End If
End If

fax = msg.HomeFaxNumber
If (Len(fax)) Then
If (InStr(1, fax, "FAX", 1)) Then
Else
msg.HomeFaxNumber = "FAX " & fax
msg.Save
End If
End If

fax = msg.OtherFaxNumber
If (Len(fax)) Then
If (InStr(1, fax, "FAX", 1)) Then
Else
msg.OtherFaxNumber = "FAX " & fax
msg.Save
End If
End If

Next msg
End Sub