Hallo Andreas,
Ich hab dir mal einen Kompletten E-Mail Header rauskopiert und
die persönlichen Daten mit xxx überschreiben
Alles klar, danke.
Ich fand im Internet dies:
/t/mit-vba-den-header-einer-email-auslesen/1717871
aber es läuft bei mir nicht, Vielleicht fehlt noch ein Verweis, k.A.
Fehler: Benutzerdefinierter Typ nicht definiert bei Mapi.session.
Ich fand auch diesen Code von einem Frank, da läuft der Code, aber das Ergebnis ist nicht das gesuchte, Verweis auf MS Outlokk x.0 object library setzen! (die If Ucase… hab ich rausgenommen damit überhaupt was geschrieben wird.)
Sub GrapIext()
' An den Absender Anpassen!!!
Const strAbsenderName As String = "[email protected]"
' Ende "An den Absender Anpassen!!!"
Dim objOutlook As Outlook.Application
Dim objnSpace As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Dim objMsg As Object
Dim objItem As Outlook.MailItem
Dim intCounter As Integer, intCount As Integer, iRow As Integer
Dim ws As Worksheet
Dim sText As String
Application.ScreenUpdating = False
Set objOutlook = CreateObject("Outlook.Application")
Set objnSpace = objOutlook.GetNamespace("MAPI")
Set objFolder = objnSpace.GetDefaultFolder(olFolderInbox)
intCount = objFolder.Items.Count
If intCount \> 0 Then
Set ws = ActiveSheet
iRow = 1
For intCounter = 1 To intCount
Set objMsg = objFolder.Items(intCounter)
If objMsg.Class = olMail Then
Set objItem = objMsg
STOP
' Hier Objekt "objItem" ansehen!!!
If UCase(objItem.SenderName) = UCase(strAbsenderName) Then
iRow = iRow + 1
ws.Cells(iRow, 1).Value = objItem.Body
End If
End If
Next intCounter
Set ws = Nothing
End If
Set objnSpace = Nothing
Set objFolder = Nothing
Set objMsg = Nothing
Set objOutlook = Nothing
End Sub
Gruß
Reinhard