vba - Import body of all .msg files located in local drive, to and Excel sheet (NOT OUTLOOK) -

i'm trying import multiple .msg files excel sheet (msg body per row)but far reference found here, code far let you:

• select folder path (where .msg located)
• loop through .msg files

but i'm unable figure out how achieve objective. in advance response.

code:

    sub importmsg()     application.screenupdating = false     application.enableevents = false     application.displayalerts = false      dim long     dim inpath string     dim thisfile string     dim msg mailitem     dim olapp object     dim ws worksheet      set ws = thisworkbook.worksheets("main")     set olapp = createobject("outlook.application")      application.filedialog(msofiledialogfolderpicker)        .allowmultiselect = false             if .show = false                 exit sub             end if         on error resume next         inpath = .selecteditems(1) & "\"     end      = 1     thisfile = dir(inpath & "*.msg")     while thisfile <> ""         = + 1         dim myitem outlook.mailitem         set myitem = application.createitemfromtemplate(thisfile)         'set myitem = application.openshareditem(thisfile)         ws.cells(i, 1).value = myitem.body         'myitem.body         'myitem.subject         'myitem.display          thisfile = dir     loop      application.screenupdating = true     application.enableevents = true     application.displayalerts = true end sub 

i found error in while loop variable thisfile wasn't maintaining full path reference added concatenation again , worked, code below:

    sub importmsg()     application.screenupdating = false     application.enableevents = false     application.displayalerts = false      dim long     dim inpath string     dim thisfile string     dim msg mailitem     dim ws worksheet     dim myolapp outlook.application     dim myitem outlook.mailitem      set myolapp = createobject("outlook.application")     set ws = thisworkbook.worksheets("main")      application.filedialog(msofiledialogfolderpicker)        .allowmultiselect = false             if .show = false                 exit sub             end if         on error resume next         inpath = .selecteditems(1) & "\"     end     thisfile = dir(inpath & "*.msg")     = 4     while thisfile <> ""         set myitem = myolapp.createitemfromtemplate(inpath & thisfile)         ws.cells(i, 1) = myitem.body         = + 1         thisfile = dir()     loop      set myitem = nothing     set myolapp = nothing      application.screenupdating = true     application.enableevents = true     application.displayalerts = true end sub