Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.
One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.
Sub SortRecharges() Dim _ o_App As Outlook.Application, _ o_RechargeFolder As Outlook.MAPIFolder, _ o_ContractFolder As Outlook.MAPIFolder, _ o_YearFolder As Outlook.MAPIFolder, _ o_MonthFolder As Outlook.MAPIFolder, _ o_DayFolder As Outlook.MAPIFolder, _ o_Item As Outlook.MailItem Dim _ b_YMDFolder As Boolean, _ dt_Received As Date, _ i_Item As Integer, _ i_Items As Integer, _ s_RechargeFolderID As String s_RechargeFolderID = "000000001A447390AA6611CD9BC800AA002FC45A030085FB38B65F840A438204B33E62CC2FC4000000169FB80000" Set o_App = CreateObject("Outlook.Application") Set o_RechargeFolder = o_App.GetNamespace("Mapi").GetFolderFromID(s_RechargeFolderID) ' Verify Recharge Folder. If o_RechargeFolder.Name <> "Recharge Reports" Then MsgBox _ Prompt:="Folder is not the Recharge Reports folder." & Chr(13) & Chr(13) & "Selected folder is : " & o_RechargeFolder.Name, _ Buttons:=vbExclamation + vbOKOnly, _ Title:="ERROR : Invalid folder selected" Exit Sub End If ' Iterate the current contracts For Each o_ContractFolder In o_RechargeFolder.Folders ' We ignore "Retired" If "Retired" <> o_ContractFolder.Name Then ' Determine if we need to look at Year\Month\Day or Year only. If "ASDA" = o_ContractFolder.Name Or "Hartshorne" = o_ContractFolder.Name Or "Hill Hire" = o_ContractFolder.Name Then b_YMDFolder = True Else b_YMDFolder = False End If Debug.Print "Examining " & o_ContractFolder.Name ' Iterate the items. i_Items = o_ContractFolder.Items.Count i_Item = 0 ' NOTE : Use a reverse for loop rather than for each as the pointer is updated to the next item immediately after the move and then Next skips an item. For i_Item = i_Items To 1 Step of - 1 Set o_Item = o_ContractFolder.Items(i_Item) Debug.Print "Processing item #" & i_Item & " of " & i_Items & " reports : " & o_Item.Subject ' Mark as read If True = o_Item.UnRead Then o_Item.UnRead = False End If ' File the reports generated today in yesterday's folder. dt_Received = o_Item.ReceivedTime - 1 ' Find the appropriate destination file If b_YMDFolder = True Then Set o_YearFolder = CheckFolder(o_ContractFolder, CStr(Year(dt_Received))) Set o_MonthFolder = CheckFolder(o_YearFolder, Format(Month(dt_Received), "00")) Set o_DayFolder = CheckFolder(o_MonthFolder, Format(Day(dt_Received), "00")) Else Set o_DayFolder = CheckFolder(o_ContractFolder, CStr(Year(dt_Received))) End If o_Item.Move DestFldr:=o_DayFolder Next i_Item End If Next o_ContractFolder End Sub Function CheckFolder(o_Folder As Outlook.MAPIFolder, s_SubFolder As String) Dim o_SubFolder As Outlook.MAPIFolder Set CheckFolder = Nothing On Error Resume Next Set CheckFolder = o_Folder.Folders.Add(s_SubFolder) On Error GoTo 0 If Not CheckFolder Is Nothing Then Else Set CheckFolder = o_Folder.Folders(s_SubFolder) End If End Function
Add your voice to the tech community where 5M+ people just like you are talking about what matters.
Join the community of 500,000 technology professionals and ask your questions.