Wie exportiert man Kontaktdaten einschließlich Fotos in Outlook?
Wenn Sie Kontakte aus Outlook in eine Datei exportieren, können nur die Textinformationen der Kontakte exportiert werden. Manchmal benötigen Sie jedoch auch die Fotos zusammen mit den Textinformationen der Kontakte. Wie können Sie diese Aufgabe in Outlook bewältigen?
Exportieren Sie Kontaktdaten mit zugehörigen Fotos mithilfe von VBA-Code
Exportieren Sie Kontaktdaten mit zugehörigen Fotos mithilfe von VBA-Code
Der folgende VBA-Code kann Ihnen helfen, alle Kontakte in einem bestimmten Kontaktordner in separate Textdateien mit Fotos zu exportieren. Gehen Sie wie folgt vor:
1. Wählen Sie einen Kontaktordner aus, aus dem Sie die Kontakte mit Fotos exportieren möchten.
2. Drücken Sie dann gleichzeitig die Tasten "ALT" + "F11", um das Fenster "Microsoft Visual Basic for Applications" zu öffnen.
3. Klicken Sie anschließend auf "Einfügen" > "Modul", kopieren Sie den unten stehenden Code und fügen Sie ihn in das geöffnete leere Modul ein, siehe Screenshot:
VBA-Code: Exportieren von Kontaktdaten mit Fotos
Sub BatchExportContactPhotosandInformation()
Dim xContactItems As Outlook.Items
Dim xItem As Object
Dim xContactItem As ContactItem
Dim xContactInfo As String
Dim xShell As Object
Dim xFSO As Scripting.FileSystemObject
Dim xTextFile As Scripting.TextStream
Dim xAttachments As Attachments
Dim xAttachment As Attachment
Dim xSavePath, xEmailAddress As String
Dim xFolder As Outlook.Folder
On Error Resume Next
Set xFSO = CreateObject("Scripting.FileSystemObject")
Set xShell = CreateObject("Shell.application").BrowseforFolder(0, "Select a Folder", 0, 16)
If xShell Is Nothing Then Exit Sub
xSavePath = xShell.Items.Item.Path & "\"
If Outlook.Application.ActiveExplorer.CurrentFolder.DefaultItemType <> olContactItem Then
Set xFolder = Outlook.Application.Session.GetDefaultFolder(olFolderContacts)
Else
Set xFolder = Outlook.Application.ActiveExplorer.CurrentFolder
End If
Set xContactItems = xFolder.Items
For i = xContactItems.Count To 1 Step -1
Set xItem = xContactItems.Item(i)
If xItem.Class = olContact Then
Set xContactItem = xItem
With xContactItem
xEmailAddress = .Email1Address
If Len(Trim(.Email2Address)) <> 0 Then
xEmailAddress = xEmailAddress & ";" & .Email2Address
End If
If Len(Trim(.Email3Address)) <> 0 Then
xEmailAddress = xEmailAddress & ";" & .Email3Address
End If
xContactInfo = "Name: " & .FullName & vbCrLf & "Email: " & _
xEmailAddress & vbCrLf & "Company: " & .CompanyName & _
vbCrLf & "Department: " & .Department & _
vbCrLf & "Job Title: " & .JobTitle & _
vbCrLf & "IM: " & .IMAddress & _
vbCrLf & "Business Phone: " & .BusinessTelephoneNumber & _
vbCrLf & "Home Phone: " & .HomeTelephoneNumber & _
vbCrLf & "BusinessFax Phone: " & .BusinessFaxNumber & _
vbCrLf & "Mobile Phone: " & .MobileTelephoneNumber & _
vbCrLf & "Business Address: " & .BusinessAddress
Set xTextFile = xFSO.CreateTextFile(xSavePath & .FullName & ".txt", True)
xTextFile.WriteLine xContactInfo
If .Attachments.Count > 0 Then
Set xAttachments = .Attachments
For Each xAttachment In xAttachments
If InStr(LCase(xAttachment.FileName), "contactpicture.jpg") > 0 Then
xAttachment.SaveAsFile (xSavePath & .FullName & ".jpg")
End If
Next
End If
End With
End If
Next i
End Sub
4. Nachdem Sie den Code in das Modul eingefügt haben, klicken Sie weiter auf "Tools" > "References" im Fenster "Microsoft Visual Basic for Applications". Aktivieren Sie im erscheinenden Dialogfeld "References-Project1" die Option "Microsoft Scripting Runtime" aus der Liste der verfügbaren Referenzen, siehe Screenshot:
5. Klicken Sie auf "OK", um das Dialogfeld zu schließen, und drücken Sie dann die Taste "F5", um den Code auszuführen. Wählen Sie im erscheinenden Dialogfeld "Browse For Folder" einen Ordner aus, in dem Sie die exportierten Kontakte speichern möchten, siehe Screenshot:
6. Klicken Sie dann auf "OK". Alle Informationen einschließlich der Fotos der Kontakte wurden in Ihren angegebenen Ordner separat exportiert, siehe Screenshot:
Beste Office-Produktivitätstools
Eilmeldung: Kutools für Outlook startet kostenlose Version!
Erleben Sie die brandneue kostenlose Version von Kutools für Outlook mit über70 unglaublichen Funktionen, die Sie FÜR IMMER nutzen können! Klicken Sie jetzt, um herunterzuladen!
📧 E-Mail-Automatisierung: Automatische Antwort (Verfügbar für POP und IMAP) / E-Mails senden planen / Automatische CC/BCC nach Regeln beim Senden von E-Mails / Automatische Weiterleitung (Erweiterte Regeln) / Automatische Begrüßung hinzufügen / Automatisches Aufteilen von E-Mails mit mehreren Empfängern in einzelne Nachrichten ...
📨 E-Mail-Management: E-Mails zurückrufen / Betrugs-E-Mails nach Betreff und anderen blockieren / Duplikate E-Mails löschen / Erweiterte Suche / Ordner organisieren ...
📁 Anhänge Pro: Stapelspeichern / Stapelablösen / Stapelkomprimieren / Automatisch speichern / Automatisch abtrennen / Automatische Komprimierung ...
🌟 Interface Magic: 😊Mehr hübsche und coole Emojis / Erinnern Sie, wenn wichtige E-Mails kommen / Outlook minimieren statt schließen ...
👍 Ein-Klick-Wunder: Allen mit Anhängen antworten / Anti-Phishing-E-Mails / 🕘Zeitzone des Absenders anzeigen ...
👩🏼🤝👩🏻 Kontakte & Kalender: Kontakte aus ausgewählten E-Mails stapelweise hinzufügen / Eine Kontaktgruppe in einzelne Gruppen aufteilen / Geburtstagserinnerung entfernen ...
