i have rceived items and send items in the shared folder in inbox
the macro runs but if the new received item it is not picking up. here is the code. could you help me. great appreciated.
thanks
Code:Set Fldr = myStore.Folders("Inbox") For Each olMail In Fldr.Items If Mid(olMail.Subject, 5, 10) = "PassNotify" Then ' Received items MyDate = Format(olMail.SentOn + 3, "mmmm dd,yyyy") With ActiveSheet.Range("A6:A" & Range("A65536").End(xlUp).Row) '' adds name to file Set c = .Find(olMail.To, LookIn:=xlValues) If c Is Nothing Then '' To was not found add to worksheet ''''' get last row '' i = Sheets("Password").Range("A65536").End(xlUp).Row + 1 ActiveSheet.Cells(i, 3).Value = olMail.ReceivedTime MyDate = Format(olMail.SentOn + 3, "mmmm dd,yyyy") ActiveSheet.Cells(i, 4).Value = MyDate '' expected date End If End With Else MyArray = Trim(Split(olMail.Subject, "-")(0)) If MyArray = "PassNotify" Then ' sent items MyDate = Format(olMail.SentOn + 3, "mmmm dd,yyyy") With ActiveSheet.Range("A6:A" & Range("A65536").End(xlUp).Row) '' adds name to file Set c = .Find(olMail.To, LookIn:=xlValues) If c Is Nothing Then '' To was not found add to worksheet ''''' get last row '' ' i = Sheets("Password").Range("A65536").End(xlUp).Row + 1 ActiveSheet.Cells(i, 1).Value = olMail.To ActiveSheet.Cells(i, 2).Value = olMail.SentOn End If ActiveSheet.Cells(i, 4).Value = MyDate If ActiveSheet.Cells(i, 3).Text > MyDate Then Range(Cells(i, 1), Cells(i, 4)).Interior.ColorIndex = 35 '' color rec date greater than expected date End If End With ''' this will moe the active mail msg to another folrder however you need to provide an if statmnt so it will kno to move msg i = i + 1 Next olMail Set Fldr = Nothing Set olNs = Nothing Set olApp = Nothing Application.ScreenUpdating = True For Each Myrng In Range("C6:C" & i) If Myrng.Text = "" Then Range(Cells(Myrng.Row, 1), Cells(Myrng.Row, 4)).Interior.ColorIndex = 36 ''' you need to changeto the color index you want to see End If Next End Sub




Reply With Quote