Looping trough email folder and exporting to txt file

[gino-aviatio]

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