Wsrtjtyk

I have a folder of email files from which I'm trying to extract sender details using Dir. I need help in determining why the following code doesn't compile.

Sub UpdateReturns()

    Dim fso As Object, fld As Object, olApp As Object, MailFile As Object, MsgDetail As Object

    Dim stSearch As String, stPath As String, stFile As String, EmailFrom As String



    stPath = "C:10. Working Docs"

    stSearch = "Approve"



    Set fso = CreateObject("Scripting.FileSystemObject")

    Set fld = fso.GetFolder(stPath)

    Set olApp = CreateObject("Outlook.Application")



    MailFile = Dir(stPath & "*.msg")

    Do While MailFile <> ""

        Set MailFile = olApp.Session.OpenSharedItem(MailFile)

        Set MsgDetail = Application.ActiveInspector.CurrentItem

        EmailFrom = MsgDetail.SenderEmailAddress

        Sheets("Settings").Cells(41, 4).Value = EmailFrom

        'need to insert standard code to itterate down the list

        'and match sender names to recipient names and votes ("Approve") etc

    Loop

End Sub

I ended up working a way around it. I was just spinning my wheels with the outlook controls and I decided to work with something I know better, end result was i set it up to read from a save folder where the files are saved as text files, and i have a formula where the contents of the searched files drop to match them against sent emails.

Sub UpdateReturns()

    Dim stPath As String, mailfile As String, Fname As String, Ename As String

    Dim fso As Object, fld As Object

    Dim i As Integer, count As Integer

    Const strSearch = "From:"

    stPath = "C:10. Working Docs"



    Set fso = CreateObject("Scripting.FileSystemObject")

    Set fld = fso.GetFolder(stPath)



    mailfile = Dir(stPath & "Approve*.txt")

    count = 0

    Do While mailfile <> ""

        count = count + 1

        mailfile = Dir()

    Loop

    i = 0

    mailfile = Dir(stPath & "Approve*.txt")

    Do While count >= 1

        Open mailfile For Input As #1

        Do Until EOF(1)

        Line Input #1, textline

            If InStr(textline, "From:") > 0 Then

                    Fname = mailfile

                    Ename = textline

            End If

        Loop

        Close #1

        Range("C" & (40 + count)).Value = Fname

        Range("D" & (40 + count)).Value = Ename

        mailfile = Dir()

        count = count - 1

     Loop

End Sub

Dir returns a string that represents the file name.

Sub UpdateReturns()



    Dim fso As Object

    Dim fld As Object

    Dim olApp As Object



    Dim MailFile As Object

    Dim MailFileStr As String

    Dim MailPathFileStr As String



    Dim stPath As String

    Dim EmailFrom As String



    stPath = "C:10. Working Docs"



    Set fso = CreateObject("Scripting.FileSystemObject")

    Set fld = fso.GetFolder(stPath)



    Set olApp = CreateObject("Outlook.Application")



    MailFileStr = Dir(stPath & "*.msg")



    ' file name only, no path

    Debug.Print "MailFileStr: " & MailFileStr



    Do While MailFileStr <> ""



        ' path and file

        MailPathFileStr = stPath & "" & MailFileStr

        Debug.Print vbCr & "MailPathFileStr: " & MailPathFileStr

        Set MailFile = olApp.Session.OpenSharedItem(MailPathFileStr)



        EmailFrom = MailFile.SenderEmailAddress

        Debug.Print "EmailFrom: " & EmailFrom



        Set MailFile = Nothing



        MailFileStr = Dir    ' Get next entry.



    Loop



End Sub