Hello,

Trying to use search function to find similar problem, and try several macro with no luck.

anyway,

I have outlook msg file in some folder let say in D:\msg\. ( not in Outlook ).

I want to copy all content in each of body message to A1 sheet1.
then loop them through the files in that folder.

so 2nd msg file with go to A1 sheet2,
3rd msg file will go to A1 sheet3 and so on.

try to use this one, but still not work.

Sub importMsg()
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False

    Dim i As Long
    Dim inPath As String
    Dim thisFile As String
    Dim msg As MailItem
    Dim OlApp As Object
    Dim ws As Worksheet

    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set OlApp = CreateObject("Outlook.Application")

    With Application.FileDialog(msoFileDialogFolderPicker)
       .AllowMultiSelect = False
            If .Show = False Then
                Exit Sub
            End If
        On Error Resume Next
        inPath = .SelectedItems(1) & "\"
    End With

    i = 1
    thisFile = Dir(inPath & "*.msg")
    Do While thisFile <> ""
        i = i + 1
        Dim MyItem As 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
anyone has experience with this?

Thank you.