Hello,

bisher war ich stiller Leser und habe so manches schon verwenden können.
Aktuell stehe ich aber als "nicht VBA" Profi an.
Folgendes Problem:
In meinen Outlook sind mehrere Mail ACCOUNTS eingerichtet.
Ich versuche aus Outlook die Kontakte in Excel einzulesen.
Das funktioniert grundsätzlich ABER nur vom Default Account.

Kann mir jemand hier weiterhelfen wie ich von einen nicht Default account die Kontakte einlesen kann.

Anbei mal der VBA Code der bisher funktioniert.

Hier Liegt wohl das Problem,
Set workingFolder = olMAPI.GetNamespace("MAPI").GetDefaultFolder(10)
das ich bisher nicht geflößt bekomme.

Sub ImportDB()


Dim ns As Namespace
'Set ns = Application.Session
Set ns = Outlook.Application.Session

Dim workingFolder As Object
Dim i As Integer
Dim olMAPI As New Outlook.Application

Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets("DB")

'Arbeitsblatt Wechseln
    Sheets("DB").Select
   
'Format the target worksheet.
   With wsSheet
        .Range("A1").CurrentRegion.Clear
        .Cells(1, 1).Value = "Vorname"
        .Cells(1, 2).Value = "Nachname"
        .Cells(1, 3).Value = "Firma"
        .Cells(1, 4).Value = "Ver. Zeile 1"
        .Cells(1, 5).Value = "Ver. Zeile 2"
        .Cells(1, 6).Value = "Ver. Zeile 3"
        .Cells(1, 7).Value = "Ver. Zeile 4"
        .Cells(1, 8).Value = "Kontonummer;BIC"
        .Cells(1, 9).Value = "Kundennummer"
        .Cells(1, 10).Value = "PLZ"
        .Cells(1, 11).Value = "Ort"
        .Cells(1, 12).Value = "Strasse + HNR"
        .Cells(1, 13).Value = "E-Mail (Verrechnung)"
        .Cells(1, 14).Value = "Fax. Nummer (VOIP)"
        .Cells(1, 15).Value = "Tel. Nummer1 (VOIP)"
        .Cells(1, 16).Value = "Tel. Nummer2 (VOIP)"
        
        With .Range("A1:Q1")
            .Font.Bold = True
            .Font.ColorIndex = 10
            .Font.Size = 11
        End With
    End With

'Wo soll man das hinschreiben
    Range("A2").Select
   'Set workingFolder = olMAPI.GetNamespace("MAPI").Accounts.Item(4).Session.GetDefaultFolder(10)
   Set workingFolder = olMAPI.GetNamespace("MAPI").GetDefaultFolder(10)
   'Set workingFolder = olMAPI.GetNamespace("MAPI").Session.PickFolder
   
   
   
   For i = 1 To workingFolder.Items.Count
    Set objItem = workingFolder.Items(i)
    With objItem
        ActiveCell.Value = .FirstName
        ActiveCell.Offset(0, 1).Value = .LastName
        ActiveCell.Offset(0, 2).Value = .CompanyName
        ActiveCell.Offset(0, 3).Value = .User1
        ActiveCell.Offset(0, 4).Value = .User2
        ActiveCell.Offset(0, 5).Value = .User3
        ActiveCell.Offset(0, 6).Value = .User4
        ActiveCell.Offset(0, 7).Value = .BillingInformation
        ActiveCell.Offset(0, 8).Value = .CustomerID
        ActiveCell.Offset(0, 9).Value = .BusinessAddressPostalCode
        ActiveCell.Offset(0, 10).Value = .BusinessAddressCity
        ActiveCell.Offset(0, 11).Value = .BusinessAddressStreet
        ActiveCell.Offset(0, 12).Value = .Email1Address
        ActiveCell.Offset(0, 13).Value = .BusinessFaxNumber
        ActiveCell.Offset(0, 14).Value = .BusinessTelephoneNumber
        ActiveCell.Offset(0, 15).Value = .Business2TelephoneNumber
        
      
        
   
     End With
     ActiveCell.Offset(1, 0).Select
   Next i
   
   Set objItem = Nothing
   Set olMAPI = Nothing
   
 'Arbeitsblatt Zurück-Wechseln
    Sheets("Rechnung").Select
   
End Sub