MS-Office-Forum

Zurück   MS-Office-Forum > Microsoft Office > Microsoft Outlook (Express), sonst. Mailprogramme
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads
Themen-Optionen Ansicht
Alt 12.04.2019, 07:47   #1
forumseeker
MOF User
MOF User
Standard Exchange - Kontakte exportieren

Hallo,

ich will nachts automatisch die Kontakte eines accounts in eine Datei exportieren. Da es ja in Outlook/Exchange kein Makrorecorder gibt, gibt es einen VBA Code, der das machen kann?

Gruss,

Andreas

Geändert von forumseeker (12.04.2019 um 07:48 Uhr). Grund: Rechtschreibfehler
forumseeker ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 12.04.2019, 08:01   #2
hubert17
MOF User
MOF User
Standard

Hallo Andreas,

mit:
Code:

Option Explicit

Sub KontakteExportieren()

Dim objOutlook As Object
Dim objNamespace As Object
Dim colContacts As Object
Dim objExcel As Object
Dim objWorkbook  As Object
Dim objWorksheet   As Object
Dim i As Integer
Dim objContact As Object
Dim objRange 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

    Set objExcel = CreateObject("Excel.Application")
    objExcel.Visible = True
    Set objWorkbook = objExcel.Workbooks.Add()
    Set objWorksheet = objWorkbook.Worksheets(1)

    objExcel.Cells(1, 1) = "Name"
    objExcel.Cells(1, 2) = "Business Phone"
    objExcel.Cells(1, 3) = "FirstName"
    objExcel.Cells(1, 4) = "LastName"

    i = 4

    For Each objContact In colContacts
        objExcel.Cells(i, 1).Value = objContact.FullName
        objExcel.Cells(i, 2).Value = objContact.BusinessTelephoneNumber
        objExcel.Cells(i, 3).Value = objContact.FirstName
        objExcel.Cells(i, 4).Value = objContact.LastName
        i = i + 1
    Next

    Set objRange = objWorksheet.UsedRange
    objRange.EntireColumn.AutoFit
    
End Sub
speicherst du deine Kontakte in einer Excel-Datei.

__________________

Gruß
Hubert
hubert17 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 12.04.2019, 11:26   #3
forumseeker
Threadstarter Threadstarter
MOF User
MOF User
Standard

Hallo!

Besten Dank für den code. Aber er funktioniert bei mir nicht genau. Zur Verdeutlichung: Ich habe im Exchange meinen eigenen Account und den eines anderen. Ich will aber nicht MEINE Kontakte exportieren (in csv), sondern die des anderen. Geht auch das?

Gruss,

Andreas
forumseeker ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 15.04.2019, 12:55   #4
hubert17
MOF User
MOF User
Standard

Hallo Andreas,

versuche es mal hiermit
Code:

Sub KontakteExportieren_2()

Dim objOutlook As Object
Dim objNamespace As Object
Dim colContacts As Object
Dim objExcel As Object
Dim objWorkbook  As Object
Dim objWorksheet   As Object
Dim i As Integer
Dim objContact As Object
Dim objRange As Object
Dim objOwner As Outlook.Recipient
Dim strBenutzer As String

    ' hier den Namen des anderen Benutzers eintragen
    strBenutzer = "Anderer Benutzer"
       
    On Error Resume Next

'    Const olFolderContacts = 10

    Set objOutlook = CreateObject("Outlook.Application")
    Set objNamespace = objOutlook.GetNamespace("MAPI")
    
    Set objOwner = objNamespace.CreateRecipient(strBenutzer)
    objOwner.Resolve
       
    If objOwner.Resolved Then
        Set colContacts = objNamespace.GetSharedDefaultFolder(objOwner, olFolderContacts)
    End If

    Set objExcel = CreateObject("Excel.Application")
    objExcel.Visible = True
    Set objWorkbook = objExcel.Workbooks.Add()
    Set objWorksheet = objWorkbook.Worksheets(1)

    objExcel.Cells(1, 1) = "Name"
    objExcel.Cells(1, 2) = "Business Phone"
    objExcel.Cells(1, 3) = "FirstName"
    objExcel.Cells(1, 4) = "LastName"

    i = 4

    For Each objContact In colContacts
        objExcel.Cells(i, 1).Value = objContact.FullName
        objExcel.Cells(i, 2).Value = objContact.BusinessTelephoneNumber
        objExcel.Cells(i, 3).Value = objContact.FirstName
        objExcel.Cells(i, 4).Value = objContact.LastName
        i = i + 1
    Next

    Set objRange = objWorksheet.UsedRange
    objRange.EntireColumn.AutoFit
    
End Sub
aber nicht vergessen den Namen des anderen Benutzerkontos zu ändern. Da ich nur ein Konto habe, kann ich es nicht testen.

__________________

Gruß
Hubert
hubert17 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 09:46 Uhr.



Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.

Copyright ©2000-2018 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günter Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.