Træk data fra outlook til excel

Hvor er de nævnte data anført - i "subject" eller "body" - eller?

De står i body :) Der er nemlig mange flere linier end den jeg har skrevet op :)

Der skal noget VBA til..

Jep :D Det tænkte jeg nok - har du et forslag på noget kode?

Jeg havde tænkt på det er fx.

Sub GetFromInbox()

    Dim olApp As Outlook.Application
    Dim olNs As NameSpace
    Dim Fldr As MAPIFolder
    Dim olMail As Variant
    Dim i As Integer

    Set olApp = New Outlook.Application
    Set olNs = olApp.GetNamespace("MAPI")
    Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
    i = 1

    For Each olMail In Fldr.Items
        If InStr(olMail.Body, "Salg i perioden") > 0 Or _
            InStr(olMail.Subject, "Salg i perioden") > 0 Then

            ActiveSheet.Cells(i, 1).Value = olMail.ReceivedTime
            i = i + 1
        End If
    Next olMail

    Set Fldr = Nothing
    Set olNs = Nothing
    Set olApp = Nothing

End Sub

Har ikke tid lige nu p.g.a. kundeopgave - vender tilbage

Okay, Super - mange tak skal du have!

Hej igen

Har du mulighed for at sende en testmail med realistisk indhold - så jeg har noget at teste på?

@-adresse under min profil.

Hej! Jeg vender lige tilbage i starten af næste uge! Jeg er nemlig på kursus hele ugen, så kan ikke lige tilgå mit materiale....

Men vender snareste tilbage, og tak fordi du gider hjælpe..
.
Har forresten fået det til at gøre sådan det smider hele mailen ind i excel, nu har jeg blot de tproblem at jeg skal få det ud i forskellige celler, men vender ligetilbage på mandag..


tak

Hej

Ok - jeg afventer & fortsat godt kursus..

Rem Kode indlagt under Ark1 i Excelfil

Sub GetFromInbox()
Dim linjer As Variant, felter As Variant, felt As Variant
Dim bodyTekst As String, overskriftStart As Variant
Dim i As Integer, p As Long, ræk As Long

Dim olApp As Outlook.Application
Dim olNs As Namespace
Dim Fldr As MAPIFolder
Dim olMail As Variant
Const startRæk = 1

    Set olApp = New Outlook.Application
    Set olNs = olApp.GetNamespace("MAPI")
    Set Fldr = olNs.GetDefaultFolder(olFolderInbox)

    For Each olMail In Fldr.Items
        If InStr(olMail.Body, "Terminal S/N") = 1 Then
           
           
            bodyTekst = olMail.Body
            p = InStr(bodyTekst, "Terminal id")
            If p > 0 Then
                overskriftStart = Mid(bodyTekst, p)
                Exit For
            Else
                MsgBox "Overskrift ikke identificeret"
            End If
        End If
    Next olMail

    Set Fldr = Nothing
    Set olNs = Nothing
    Set olApp = Nothing
   
    ræk = startRæk
       
    linjer = Split(overskriftStart, Chr(13) & Chr(10))
    For l = 0 To UBound(linjer)
        If linjer(l) <> "" Then
            linjer(l) = Replace(linjer(l), Chr(34), "")
            felter = Split(linjer(l), ",")
            For f = 0 To UBound(felter)
                felt = felter(f)
                If felt = "" Then
                    Exit For
                End If
                Cells(ræk, f + 1) = felt
            Next f
        Else
            felt = ""
        End If
        If felt <> "" Then
            ræk = ræk + 1
        End If
    Next l
    Columns.AutoFit
End Sub

Super godt arbejde! Tak for hjælpen!