VBOffice

Mehrere Kontakte gleichzeitig ändern

Im Beispiel wird der Firmenname für alle ausgewählten Kontakte geändert.

Zuletzt geändert: 06.12.2016 | Aufrufe: 73.172  | #18
◀ Vorheriges Beispiel Nächstes Beispiel ▶

Inhalt

OLKeeper OLKeeper
Der OLKeeper verhindert zuverlässig, dass Sie Microsoft Outlook unbeabsichtigt schließen und so etwa wichtige Emails verpassen würden.

Firma ändern

Wenn Sie zwei Kontakte in der gleichen Firma haben, dann speichert Outlook z.B. den Firmennamen auch zweimal. Das merken Sie spätestens dann, wenn sich dieser ändert: Dann müssen Sie die Änderungen für jeden Kontakt in der Firma einzeln vornehmen.

Das folgende Beispiel nimmt Ihnen diese Arbeit ab, funktioniert aber erst ab Outlook XP. Wenn Sie alle Kontakte der Firma gefunden haben, können Sie natürlich auch andere Eigenschaften, z.B. E-Mail-Adressen, ändern.


tip  So fügen Sie Makros in Outlook ein
Public Sub ChangeCompanyName()
  Dim sSearch As String
  Dim sFolder As String

  sFolder = "Kontakte"

  sSearch = InputBox("Firma:")
  If Len(sSearch) Then
    sSearch = "urn:schemas:contacts:o = '" & sSearch & "'"
    Application.AdvancedSearch sFolder, sSearch
  End If
End Sub

Private Sub Application_AdvancedSearchComplete(ByVal SearchObject As Outlook.Search)
  If SearchObject.Results.Count Then
    ChangeNames SearchObject.Results
  End If
End Sub

Private Sub ChangeNames(Results As Outlook.Results)
  Dim obj As Object
  Dim oContact As Outlook.ContactItem
  Dim sNew As String
  Dim i As Long
  
  sNew = InputBox("Neuer Name:")
  If Len(sNew) Then
    For i = Results.Count To 1 Step -1
      Set obj = Results(i)
      If TypeOf obj Is Outlook.ContactItem Then
        Set oContact = obj
        oContact.CompanyName = sNew
        oContact.Save
      End If
    Next
  End If
End Sub
SAM SAM
Legen Sie fest, mit welcher "Identität" Ihre Emails beim Empfänger erscheinen sollen. Mit SAM bestimmen Sie den Absender und Speicherort für Emails anhand von Regeln.

Domain in Emailadresse ändern

Dieses Beispiel ersetzt bei allen Kontakten des aktuellen Ordners einen Teil der Emailadresse durch einen anderen. In der Variable 'Find' steht der zu suchende Teil, in 'ReplaceBy' der neue Wert.

Public Sub ChangeDomainInEmailAddresses()
  Dim Items As Outlook.Items
  Dim Contact As Outlook.ContactItem
  Dim obj As Object
  Dim Find As String
  Dim ReplaceBy As String
  
  Find = "@domain.de"
  ReplaceBy = "@domain.com"
  
  Set Items = Application.ActiveExplorer.CurrentFolder.Items
  For Each obj In Items
    If TypeOf obj Is Outlook.ContactItem Then
      Set Contact = obj
      If InStr(1, Contact.Email1Address, Find, vbTextCompare) Then
        Contact.Email1Address = Replace(Contact.Email1Address, Find, ReplaceBy, , , vbTextCompare)
        Contact.Save
      End If
    End If
  Next
End Sub
ReplyAll 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.
email  Senden Sie eine Nachricht