Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.
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.
Private Sub cmdRefresh_click() Dim olApp As Outlook.Application Dim olNs As Outlook.NameSpace Dim strFolderPath As String DoCmd.SetWarnings (False) DoCmd.RunSQL "Delete * from LastWeek" DoCmd.SetWarnings (True) Dim RS As New ADODB.Recordset RS.Open "Emails", CurrentProject.Connection, adOpenDynamic, adLockOptimistic Set olApp = New Outlook.Application Set olNs = olApp.GetNamespace("MAPI") Dim olFldr As Outlook.MAPIFolder Set olFldr = olNs.GetDefaultFolder(olPublicFoldersAllPublicFolders).Folders("Transactions") Call ProcessFolder(olFldr) End Sub Sub ProcessFolder(StartFolder As MAPIFolder) Dim objFolder As Outlook.MAPIFolder Dim objItem As Object Dim objEmail As MailItem Dim mailObject As Object Dim dtReceived As Date Dim strSubject As String On Error Resume Next Set objApp1 = Outlook.Application Set objNS1 = objApp1.GetNamespace("MAPI") Dim RS As New ADODB.Recordset RS.Open "LastWeek", CurrentProject.Connection, adOpenDynamic, adLockOptimistic For Each objItem In StartFolder.Items '.Folders strSubject = objItem.Subject dtReceived = CDate(objItem.Received) If (InStr(1, strSubject, "Clothes;") > 0) Or _ (InStr(1, strSubject, "Shoes") > 0) Then With RS .AddNew !Importance = objItem.Importance !Subject = objItem.Subject !from = objItem.SenderName !To = objItem.To ' ![Normalized Subject] = objItem.[Normalized Subject] !Received = objItem.Received .Update End With End If Next For Each objFolder In StartFolder.Folders Call ProcessFolder(objFolder) Next End Sub