Hilfe zum Email auslesen

[Istrion]

Guten Tag,

Wir haben bei uns im Verein aufgrund der Corona-Krise alle Konferenzen zur Verbreitung unserer Projektergebnisse durch virtuelle Konferenzen ersetzen müssen. Nun bekomme ich von jeder Registrierung eine E-Mail, die wie folgt aussieht:

Betreff: Bachelor und Meister - new registration conference
Name: Max
Surname: Mustermann
Email: max.mustermann@email.de
Country: Germany

Die E-Mails mit den Registrierungsinfos landen dann bei mir im Posteingang in dem Unterordner Registrations und dann in dem weiteren Unterordner Bachelor und Meister

Ich würde gerne die Informationen Name, Surname, Email und Country mit Excel VBA auslesen lassen und in einer übersichtlichen Tabelle zur Auswertung darstellen. Ich habe schon in dem Forum einen code zu einem ähnlichen Problem gefunden und den so umgebaut:

Code:

Option Explicit

Public Sub UebertragAntragTest()
Dim olApp          As Outlook.Application
Dim olName          As Outlook.Namespace
Dim olFolderStart  As Outlook.MAPIFolder
Dim olFolderEnd    As Outlook.MAPIFolder
Dim xlApp          As Excel.Application
Dim xlBook          As Excel.Workbook
Dim xlSheet        As Excel.Worksheet
Dim olFolderItems  As Long
Dim strNewSubject  As String
Dim vntTempArray    As Variant
Dim lngTextToVal    As Long
Dim lngZeileFzArt  As Long
Dim xlRange        As Long
Dim lngFZCount      As Long

Set olApp = Application
Set olName = olApp.GetNamespace("MAPI")
Set olFolderStart = olName.Session.Folders("Posteingang").Folders("Registrations").Folders("Bachelor und Master")
Set olFolderEnd = olName.Session.Folders("Posteingang").Folders("Registrations").Folders("Bachelor und Master") 
Set xlApp = New Excel.Application
    With xlApp
        .Visible = True
        .Workbooks.Open Environ("USERPROFILE") & "\Desktop\Registrations.xlsb"
        Set xlBook = xlApp.Workbooks("Registrations.xlsb")
        Set xlSheet = xlBook.Sheets("Import Christian")
            With xlBook
                  With xlSheet
                      For olFolderItems = olFolderStart.Items.Count To 1 Step -1
                          strNewSubject = Replace(olFolderStart.Items(olFolderItems).Subject, _
                                                  "[Bachelor und Meister - new registration conference] ", "")
                          strNewSubject = Replace(strNewSubject, "(", "")
                          strNewSubject = Replace(strNewSubject, ")", "")
                              vntTempArray = Split(olFolderStart.Items(olFolderItems).Body, vbCrLf)
                              lngTextToVal = Val(Mid(vntTempArray(40), 9, 1))
                              lngZeileFzArt = 15
                              For lngFZCount = 1 To lngTextToVal
                                  xlRange = _
                                  .Range("A" & .Rows.Count).End(xlUp).Row + 1
                                  .Range("A" & xlRange) = olFolderStart.Items(olFolderItems).SentOn
                                  .Range("B" & xlRange) = strNewSubject
                                  .Range("D" & xlRange) = lngTextToVal
                                  .Range("E" & xlRange) = Replace(vntTempArray(1), "Name:", "")
                                  .Range("F" & xlRange) = Replace(vntTempArray(2), "Surname:", "")
                                  .Range("G" & xlRange) = Replace(vntTempArray(3), "Email:", "")
                                  .Range("H" & xlRange) = Replace(vntTempArray(4), "Country:", "")
                                  .Range("T" & xlRange) = Mid(vntTempArray(44), 14, 4)
                                    lngZeileFzArt = lngZeileFzArt + 5
                              Next lngFZCount
                          End If
                          olFolderStart.Items(olFolderItems).Move olFolderEnd
                      Next olFolderItems
                  End With
                .Save
                .Close
            End With
            .Quit
    End With
End Sub

Allerdings komme ich nun nicht weiter, bei der dritten Zeile wird mir ein Fehler angezeigt. Leider sind meine Programmierkenntnisse auch nicht sehr gut. Ich habe die Datei mal als Anhang beigefügt.

Vielen Dank im Voraus, wenn mir jemand weiterhelfen kann!

Viele Grüße
Christian

[00202]

Hallo, :19:

also Schritt für Schritt - in Excel folgenden Code: :21:

Code:

Option Explicit
Public Sub Main()
    Dim objMail As Object
    Set objMail = CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Folders("Registrations").Folders("Bachelor und Master")
    With objMail
        .Display
    End With
    Set objMail = Nothing
End Sub

Wenn die Ordnerstruktur vorhanden ist, zeigt er dir jetzt den Unterordner "Bachelor und Master" an.