Need Help - Pulling string from e-mail based on subject

[laxcat73]

So my code below is supposed to find the most recent e-mail and open the URL. However, this code works for the first time correctly if there is only 1 email matching subject I input. This email is a report that links to XLS file that I need to download to do analysis on.

For example, I deleted all the report emails in my inbox, ran the report, got the email, ran the macro and it works fine. But as soon as I run the report again to generate a newer e-mail, the macro grabs the same one as last time. I cannot figure out for the life of me why. This is where I need help. Is it a function of resetting the subject search? Do I have to re-sort it then have the macro run?

For the record, my firm locks down outlook so it can't run macros itself but I can control it from Excel.

(Some things redacted)

Sub Staffing_Planner()

Dim x As Integer
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim myword As String
Dim pos1 As Long
Dim pos2 As Long
Dim word1 As String
Dim date1 As String


date1 = Format(Now, "yyyymmdd")
Set wb1 = ActiveWorkbook


Dim myOlApp As Outlook.Application
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myfolders = myNameSpace.GetDefaultFolder(olFolderInbox)
'Set myfolders2 = myNameSpace.Folders("Staffing Planner")


myword = "ResourceSummaryReport-" ' set the keyword to find


For Each Item In myfolders.Items
        itsj = Item.Subject
        If itsj <> "xxxxxxxxxxxxxxxxxx Export Assignments" Then GoTo 10
            If InStr(1, Item.Body, myword, vbTextCompare) > 0 Then
            
                pos1 = InStr(Item.Body, myword) ' Find the first character of keyword
                word1 = Mid(Item.Body, pos1, 43) ' extract the unique share name


                    Shell ("C:\Program Files\Internet Explorer\IEXPLORE.EXE" & " " & "http://xxxxxxxxxxxxxxx.com/itg/staffing/webapp/export/resource-report/" & word1)


                    End If               


GoTo 20


10
n = n + 1
Next Item


20
End Sub

 

[RickXL]

Does it work if you step through the items from the other end?

For example:

Sub xx()
    Set wb1 = ActiveWorkbook
    
    Dim myOlApp As Object
    Set myOlApp = CreateObject("Outlook.Application")
    Set myNameSpace = myOlApp.GetNamespace("MAPI")
    Set myfolders = myNameSpace.GetDefaultFolder(6)
    Dim Item As Object
    'Set myfolders2 = myNameSpace.Folders("Staffing Planner")
    
    myword = "ResourceSummaryReport-" ' set the keyword to find
    
    For j = myfolders.Items.Count To 1 Step -1
        Set Item = myfolders.Items(j)
        itsj = Item.Subject
        If itsj = "xxxxxxxxxxxxxxxxxx Export Assignments" Then
            If InStr(1, Item.Body, myword, vbTextCompare) > 0 Then
                pos1 = InStr(Item.Body, myword) ' Find the first character of keyword
                word1 = Mid(Item.Body, pos1, 43) ' extract the unique share name
                Shell ("C:\Program Files\Internet Explorer\IEXPLORE.EXE" & " " & "http://xxxxxxxxxxxxxxx.com/itg/staffing/webapp/export/resource-report/" & word1)
            End If
            Exit Sub
        End If
    Next
End Sub

I have re-arranged some lines, partly to make it run and partly because those gotos made me giddy
Also, I wasn't sure what the n = n + 1 did?