Collection of macros to download a file using Internet Explorer, collate a bunch of emails from yesterday, assess whether they're 'new' or 'updated', and then send the whole thing to a particular email address.This macro can be deployed in Outlook 2013.Why the hell do I need to do that? Well, because without authenticating into our proxy at work…

FileDownloader

Public Sub DownloadFile()
' Requires 'Sleep' function

Dim IE As Object
Dim timeout As Date
Set IE = CreateObject("InternetExplorer.Application")

IE.Visible = False

'Navigate to a page to trigger Zscaler authentication
IE.Navigate "http://any.old.site" 'CHANGE

While IE.Busy
    DoEvents
Wend

'Address to fetch file from
IE.Navigate "http://any.old.site/path/to/file.xlsx" 'CHANGE

Sleep (5)

SendKeys ("{DOWN}{DOWN}{ENTER}")

Sleep (1)

'Location to save to
SendKeys ("{%}USERPROFILE{%}\file.xls {ENTER}") 'CHANGE

'Note that this is only required in case you need to overwrite
SendKeys ("y") 

IE.Quit
Set IE = Nothing

Sleep (1)

'Close the IE Download dialogue
SendKeys ("%C") 

End Sub

SendCriticals

Public Sub SendCriticals()
    On Error GoTo On_Error
    Dim olApp As Outlook.Application
    Dim olMsg As Outlook.MailItem
    Dim Report As String
    Dim Folder As Outlook.Folder
    Dim oPA As Outlook.PropertyAccessor
    Dim YdaysDate
    Dim CurrentItem
    Dim State
    
    Call DownloadChats
    
    Set Folder = GetFolder("\\Mailbox\Folder") 'CHANGE
    Set olApp = Outlook.Application
    Set olMsg = Outlook.CreateItem(0)
    
    YdaysDate = GetDate(Now, 1)
    
    Report = "<table>"
    State = ""
    
    For Each CurrentItem In Folder.Items
        If GetDate(CurrentItem.ReceivedTime, 0) = YdaysDate And InStr(CurrentItem.Subject, "Critical Incident Ops Call Report") = 0 Then
            If InStr(CurrentItem.Subject, "Update") > 0 Or InStr(CurrentItem.Subject, "Resolved") > 0 Then
                State = "Updated"
            ElseIf InStr(CurrentItem.Subject, "Initial") > 0 Then
                State = "New"
            Else
                State = ""
            End If
            Report = Report & "<tr><td>" & YdaysDate & "</td><td>" & State & "</td><td>" & CurrentItem.Subject & "</td></tr>"
            State = ""
        End If
    Next
    
    Report = Report & "</table>"
    
    
    olMsg.Subject = "Criticals for " & GetDate(Now, 1)
    olMsg.To = "[email protected]" 'CHANGE
    olMsg.BodyFormat = olFormatHTML
    olMsg.HTMLBody = Report
    olMsg.Attachments.Add "{%}USERPROFILE{%}\file.xls" 'CHANGE
    olMsg.Send
    
Exiting:
    Set olApp = Nothing
    Set olMsg = Nothing
    Set Folder = Nothing
    Set oPA = Nothing
    Exit Sub
        
On_Error:
    MsgBox "error=" & Err.Number & " " & Err.Description
    Resume Exiting
    
End Sub

Function GetFolder(ByVal FolderPath As String) As Outlook.Folder
    Dim TestFolder As Outlook.Folder
    Dim FoldersArray As Variant
    Dim i As Integer
 
    On Error GoTo GetFolder_Error
    If Left(FolderPath, 2) = "\\" Then
        FolderPath = Right(FolderPath, Len(FolderPath) - 2)
    End If
    'Convert folderpath to array
    FoldersArray = Split(FolderPath, "\")
    Set TestFolder = Application.Session.Folders.Item(FoldersArray(0))
    If Not TestFolder Is Nothing Then
        For i = 1 To UBound(FoldersArray, 1)
            Dim SubFolders As Outlook.Folders
            Set SubFolders = TestFolder.Folders
            Set TestFolder = SubFolders.Item(FoldersArray(i))
            If TestFolder Is Nothing Then
                Set GetFolder = Nothing
            End If
        Next
    End If
    'Return the TestFolder
    Set GetFolder = TestFolder
    Exit Function
 
GetFolder_Error:
    Set GetFolder = Nothing
    Exit Function
End Function

Function GetDate(dt As Date, o As Integer) As String
    GetDate = Month(dt) & "/" & Day(dt) - o & "/" & Year(dt)
End Function

Sleep

Public Sub Sleep(Seconds As Integer)
    Dim timeout As Date
    timeout = Now + TimeSerial(0, 0, Seconds)
    
    Do
        DoEvents
    Loop Until Now > timeout
    
End Sub