none
Excel VBA: How can I search, open, update and save Outlook Contactitem from excel effective RRS feed

  • Frage

  • Moin, ich arbeite mit Kontakten in einem Excelsheet. Ich würde jetzt die doppelte Datenhaltung reduzieren wollen und direkt mit meinen Outlook-Kontakten arbeiten. Ich kann diese aus Outlook auslesen und aber leider kann ich diese nicht zurück speichern. Ich habe leider keine passende Lektüre gefunden die mir den Umgang mit Outlook Objekten einfach erklärt.

    Welche Methoden gibt es dafür? Das Formular soll auch auf alten Versionen (ab Excel 2007) laufen.

    Was ist die beste Methode dafür?

    Selbst der einfache Versuch die Änderung über den Outlook-Dialog zu machen ist mir nicht gelungen.

    ...................

    Sub OL_Kontakt_Oeffnen()

    'Suchvariablen (Vorname/Nachname)
    Dim XLSUVN, XLSUNN As String
    Dim objOutlook, objNameSpace As Object
    Dim colContacts As Variant
    Dim objContact As Object

    On Error Resume Next

    Const olFolderContacts = 10

    Set objOutlook = CreateObject("Outlook.Application")
    Set objNameSpace = objOutlook.GetNamespace("MAPI")

    Set colContacts = objNameSpace.GetDefaultFolder(olFolderContacts).Items

    MsgBox (colContacts.Count)

    'Übernahme Suchkriterien

    XLSUVN = ActiveWorkbook.Sheets("Kontaktdaten").Range("I3").Value
    XLSUNN = ActiveWorkbook.Sheets("Kontaktdaten").Range("I4").Value
    If Len(XLSUVN) = 0 And Len(XLSUVN) = 0 Then Exit Sub

    For Each objContact In colContacts
           
            If UCase(Left(XLSUVN, Len(XLSUVN))) = UCase(Left(objContact.FirstName, Len(XLSUVN))) And _
               UCase(Left(XLSUNN, Len(XLSUNN))) = UCase(Left(objContact.lastName, Len(XLSUNN))) Then
               
               objOutlook.objNameSpace.colContacts(objContact).Open
               
              Exit For
            End If
     Next
    End Sub

    ...................

    Danke Grüße

    Dienstag, 26. Juli 2016 17:53

Alle Antworten

  • Option Explicit
    
    #Const Develop = False
    
    Sub Example_Search_Contacts_In_Outlook()
    #If Develop Then
      'Set a reference to 'Microsoft Outlook ??.? Object Library' before!
      Dim objOutlook As Outlook.Application
      Dim objNameSpace As Outlook.Namespace
      Dim colContacts As Outlook.Items
      Dim objContact As Outlook.ContactItem
    #Else
      Const olFolderContacts = 10
      Dim objOutlook As Object
      Dim objNameSpace As Object
      Dim colContacts As Object
      Dim objContact As Object
    #End If
      Dim FName As String, LName As String, SQL As String
    
      'Search for this person
      FName = "Andreas"
      LName = "Killer"
    
      'Connect to Outlook
      Set objOutlook = GetOutlook
      Set objNameSpace = objOutlook.GetNamespace("MAPI")
      Set colContacts = objNameSpace.GetDefaultFolder(olFolderContacts).Items
    
      'Default search string with placeholders
      SQL = "[FirstName] = '@FirstName' And [LastName] = '@LastName'"
    
      'Replace the placeholder with our values
      SQL = Replace(SQL, "@FirstName", FName)
      SQL = Replace(SQL, "@LastName", LName)
      'Execute
      Set objContact = colContacts.Find(SQL)
    
      If objContact Is Nothing Then
        'Not found
      Else
        Do
          'Show
          'objContact.Display
    
          'Change a property
          objContact.BusinessAddressCity = "Hannover"
          'Save it!
          objContact.Save
    
          'Search next
          Set objContact = colContacts.FindNext
        Loop Until objContact Is Nothing
      End If
    End Sub
    
    Private Function GetOutlook() As Object
      On Error Resume Next
      Set GetOutlook = GetObject(, "Outlook.Application")
      If GetOutlook Is Nothing Then Set GetOutlook = CreateObject("Outlook.Application")
    End Function
    

    Mittwoch, 27. Juli 2016 10:04