Auszug outlook-Nachrichtentext mit VBA aus Excel

also ich habe in der Lage, um es arbeiten mit .msg-Dateien außerhalb von outlook. Da ich jedoch keinen Zugriff auf Outlook Express habe ich keine Möglichkeit zu speichern .eml-Dateien im moment. Hier ist ein Sub habe ich mit eingefügt werden Betreff,Absender,CC,Um, und SendOn in ein excel-Arbeitsblatt, beginnend bei Zeile 2 Spalte 1 (unter der Annahme einer header-Zeile in Zeile 1):

Sub GetMailInfo(Path As String)

    Dim MyOutlook As Outlook.Application
    Dim msg As Outlook.MailItem
    Dim x As Namespace

    Set MyOutlook = New Outlook.Application
    Set x = MyOutlook.GetNamespace("MAPI")

    FileList = GetFileList(Path + "*.msg")


    row = 1

    While row <= UBound(FileList)

        Set msg = x.OpenSharedItem(Path + FileList(row))

        Cells(row + 1, 1) = msg.Subject
        Cells(row + 1, 2) = msg.Sender
        Cells(row + 1, 3) = msg.CC
        Cells(row + 1, 4) = msg.To
        Cells(row + 1, 5) = msg.SentOn


        row = row + 1
    Wend

End Sub

verwendet GetFileList Funktion, wie unten definiert
(Dank an spreadsheetpage.com)

Function GetFileList(FileSpec As String) As Variant
'   Taken from http://spreadsheetpage.com/index.php/tip/getting_a_list_of_file_names_using_vba/
'   Returns an array of filenames that match FileSpec
'   If no matching files are found, it returns False

    Dim FileArray() As Variant
    Dim FileCount As Integer
    Dim FileName As String

    On Error GoTo NoFilesFound

    FileCount = 0
    FileName = Dir(FileSpec)
    If FileName = "" Then GoTo NoFilesFound

'   Loop until no more matching files are found
    Do While FileName <> ""
        FileCount = FileCount + 1
        ReDim Preserve FileArray(1 To FileCount)
        FileArray(FileCount) = FileName
        FileName = Dir()
    Loop
    GetFileList = FileArray
    Exit Function

'   Error handler
    NoFilesFound:
        GetFileList = False
End Function

Sollte Recht einfach sein, lassen Sie mich wissen, wenn Sie benötigen keine weitere Erklärung.

Edit: Sie haben auch fügen Sie einen Verweis auf die outlook-Bibliothek

HTH!

Z

' Der code unten wird in der Lage sein, fast alle Nachrichten von Outlook,
"außer, und ich weiß nicht, warum, wenn Sie arbeiten mit Nachrichten generiert
'Exchange-Server wie z.B. "Mail Delivery System". Es tut, wie es aussieht, ist nicht ein
"wirklich Nachricht an dieser Stelle. Wenn Sie versuchen, es zu Lesen, das Objekt "olItem" ist
'immer Leer. Jedoch wenn Sie erhalten diese Warnung, "Mail Delivery System" und " vorwärts
'zu sich selbst und dann versuchen, es zu Lesen, es funktioniert gut. Fragt mich nicht
"warum, weil ich keine Ahnung. Ich denke nur, dass diese "Mail Delivery System"
"zunächst mal ist es eine Warnung und nicht eine Nachricht, auch das Symbol ändert sich, es
"nicht ein Briefumschlag-Symbol, sondern eine Lieferung, die mit Erfolg oder nicht-Symbol. wenn Sie
'keine Ahnung, wie es zu handhaben, bitte adivise

Set olApp = New Outlook.Application
Set olNamespace = olApp.GetNamespace("MAPI")

Set olInbox = olNamespace.GetDefaultFolder(olFolderInbox).Folders("mFolder")


On Error Resume Next

i = 5
cont1 = 0
Sheet2.Cells(4, 1) = "Sender"
Sheet2.Cells(4, 2) = "Subject"
Sheet2.Cells(4, 3) = "Received"
Sheet2.Cells(4, 4) = "Recepient"
Sheet2.Cells(4, 5) = "Unread?"
Sheet2.Cells(4, 6) = "Link to Report"

For Each olItem In olInbox.Items

    myText = olItem.Subject
    myTokens = Split(myText, ")", 5)
    myText = Mid(myTokens(0), 38, Len(myTokens(0)))
    myText = RTrim(myText)
    myText = LTrim(myText)
    myText = myText & ")"
    myLink = ""

    myArray = Split(olItem.Body, vbCrLf)
    For a = LBound(myArray) To UBound(myArray)
         If a = 4 Then
           myLink = myArray(a)
           myLink = Mid(myLink, 7, Len(myLink))
         End If
    Next a

    Sheet2.Cells(i, 1) = olItem.SenderName
    Sheet2.Cells(i, 2) = myText
    Sheet2.Cells(i, 3) = Format(olItem.ReceivedTime, "Short Date")
    Sheet2.Cells(i, 4) = olItem.ReceivedByName
    Sheet2.Cells(i, 5) = olItem.UnRead
    Sheet2.Cells(i, 6) = myLink
    olItem.UnRead = False
    i = i + 1

Next