Good afternoon folks,

I am currently working on a tool to export a hole email folder to folders as an txt (every email by it self as txt file with an specific name in the right folder)

the procedure it self works but it exports the hole email including sender subject reciver etc. i got already the body as an variable but it dosnt let me export just the body...

Sub Main()
    

    'On Error Resume Next
    Set myOlApp = Outlook.Application
    Set mynamespace = myOlApp.GetNamespace("mapi")
    Set myfolder = myOlApp.ActiveExplorer.CurrentFolder
    For Each myMail In Application.ActiveExplorer.Selection
    Receive_date = myMail.SentOn
    Dim myMail2 As Outlook.MailItem
    Dim A
    Dim B
    Dim str$
    Dim str2$
    Dim thisDate As Date
    Dim thisYear As Integer
    Dim aryLines() As String
    Dim Path As String
    Dim Name1 As String
    Dim F
    For i = 1 To myfolder.Items.Count
    Set myitem = myfolder.Items(i)
    msgtext = myitem.body
    Dim Recive_date
    Receive_month = Format(Receive_date, "MM")
    Receive_year = Format(Receive_date, "YYYY")
    'MsgBox "Time Received: " & Receive_month & Receive_year
    'Next
    Set myMail = Nothing
'Creating folder path
    thisDate = Now()
    thisYear = Year(thisDate)
    thisMonth = MonthName(Month(thisDate))
    A = Receive_year
    B = Receive_month
    
     str = "C:\Users\215325\Desktop\Notam" & A
    str2 = str & "\" & B
        'MsgBox str2
    If Dir(str, vbDirectory) = "" Then
    MkDir (str)
        'MsgBox "Ordner " & A & " wurde angelegt!"
    Else
        'MsgBox "Ordner " & A & " ist vorhanden!"
    End If
    If Dir(str2, vbDirectory) = "" Then
    MkDir (str2)
        'MsgBox "Ordner " & B & " wurde angelegt!"
    Else
        'MsgBox "Ordner " & B & " ist vorhanden!"
    End If
'Set name for txt file
    For Each myMail2 In Application.ActiveExplorer.Selection
    F = Receive_date
    F = Replace(F, " ", "")
    F = Replace(F, ":", "")
    F = Replace(F, ".", "")
    Path = "C:\Users\215325\Desktop\Notam" & A & "\" & B & "\"
    arr = Split(myitem.body, vbCrLf)
    Name1 = arr(0) & arr(2) & arr(3) & "_" & F & ".txt"
    
   
    Name1 = Replace(Name1, " ", "_")
    Name1 = Replace(Name1, "\", "_")
    Name1 = Replace(Name1, "/", "_")
    Name1 = Replace(Name1, "A)", "_")
    Name1 = Replace(Name1, "B)", "_")
    Name1 = Replace(Name1, "C)", "_")
       
    
    
    myitem.SaveAs Path & Name1, loTXT
  
    Next
    Next
    Next

End Sub