Option Explicit Private lRow As Long, x As Date, oWS As Worksheet Sub GetFromInbox() Const olFolderInbox = 6 Dim olApp As Object, olNs As Object Dim oRootFldr As Object ' Root folder to start Dim lCalcMode As Long Set olApp = CreateObject("Outlook.Application") Set olNs = olApp.GetNamespace("MAPI") Set oRootFldr = olNs.GetDefaultFolder(olFolderInbox).Folders("PRE Customer") Set oWS = ActiveSheet x = Date lRow = 1 lCalcMode = Application.Calculation Application.Calculation = xlCalculationManual Application.ScreenUpdating = False GetFromFolder oRootFldr Application.ScreenUpdating = True Application.Calculation = lCalcMode Set oWS = Nothing Set oRootFldr = Nothing Set olNs = Nothing Set olApp = Nothing End Sub Private Sub GetFromFolder(oFldr As Object) Dim oItem As Object, oSubFldr As Object ' Process all mail items in this folder For Each oItem In oFldr.Items If TypeName(oItem) = "MailItem" Then