Sub mail_attachments_download()
Dim objOutlookApp As Object, objMail As Object
Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
Dim objOutlApp As Object, oNSpace As Object, oIncoming As Object
Dim oIncMails As Object, oMail As Object, oAtch As Object
Dim IsNotAppRun As Boolean
Dim sFolder As String, st As String, bodym As String
Application.ScreenUpdating = False
actbk = ThisWorkbook.Name
On Error Resume Next
Set objOutlApp = GetObject(, "outlook.Application")
If objOutlApp Is Nothing Then
    Set objOutlApp = CreateObject("outlook.Application")
    IsNotAppRun = True
End If


Set oNSpace = objOutlApp.GetNamespace("MAPI")
Set oIncoming = oNSpace.GetDefaultFolder(6)
Set oIncMails = oIncoming.Items


    For Each oMail In oIncMails.Restrict("[Unread]=TRUE")
        For Each oAtch In oMail.Attachments
            For i = 2 To Workbooks(actbk).Worksheets("Suppliers list page").UsedRange.Rows.Count
                If InStr(1, oAtch, Workbooks(actbk).Worksheets("Suppliers list page").UsedRange.Cells(i, 1).Value, vbTextCompare) <> 0 Then
                    If Right(oAtch, 4) = ".xls" Then
                        mnslft = 4
                    Else
                        mnslft = 5
                    End If
                    sFolder = Workbooks(actbk).Worksheets(2).UsedRange.Cells(i, 2).Value
                    If Right(sFolder, 1) <> "\" Then
                        sFolder = sFolder & "\"
                    End If
                    oAtch1 = Left(oAtch, Len(oAtch) - mnslft) & " (Downloaded " & Left(Now, 10) & ")" & Right(oAtch, mnslft)
                    oAtch3 = Left(oAtch, Len(oAtch) - mnslft) & " (Downloaded " & Left(Now, 13) & "h" & Left(Right(Now, 5), 2) & "m" & Right(Now, 2) & "s)"
                    st = sFolder & oAtch1
                    oAtch.SaveAsFile st
                    n = Workbooks(actbk).Worksheets("Archive page").UsedRange.Rows.Count + 1
                    Workbooks(actbk).Worksheets("Archive page").UsedRange.Cells(n, 1).Value = Workbooks(actbk).Worksheets("Suppliers list page").UsedRange.Cells(i, 1).Value
                    Workbooks(actbk).Worksheets("Archive page").UsedRange.Cells(n, 2).Value = oMail.Sender.GetExchangeUser.PrimarySmtpAddress
                    Workbooks(actbk).Worksheets("Archive page").UsedRange.Cells(n, 3).Value = oAtch 
                    Workbooks(actbk).Worksheets("Archive page").UsedRange.Cells(n, 4).FormulaR1C1 = "=HYPERLINK(""" & sFolder & """,""" & sFolder & """)"
                    Workbooks(actbk).Worksheets("Archive page").UsedRange.Cells(n, 5).Value = Now
                    oMail.Unread = False
                    oMail.SaveAs (sFolder & "Mail archive\" & oAtch3 & ".msg")
                End If
            Next
        Next
    Next
End Sub