Sub ExportAdvisoriesToExcel()
    Dim olApp As Outlook.Application
    Dim olNamespace As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder
    Dim olMail As Outlook.MailItem
    Dim xlApp As Object
    Dim xlWB As Object
    Dim xlSheet As Object
    Dim i As Integer

    Set olApp = Outlook.Application
    Set olNamespace = olApp.GetNamespace("MAPI")
    Set olFolder = olNamespace.GetDefaultFolder(olFolderInbox) 'Adjust folder if necessary

    Set xlApp = CreateObject("Excel.Application")
    Set xlWB = xlApp.Workbooks.Add
    Set xlSheet = xlWB.Sheets(1)

    ' Set Headers
    xlSheet.Cells(1, 1).Value = "Title"
    xlSheet.Cells(1, 2).Value = "Severity"
    xlSheet.Cells(1, 3).Value = "Type"
    xlSheet.Cells(1, 4).Value = "Date Received"

    i = 2

    For Each olMail In olFolder.Items
        If InStr(olMail.Subject, "Advisory") > 0 Then ' Adjust keyword as necessary
            xlSheet.Cells(i, 1).Value = olMail.Subject

            ' Example parsing severity and type (custom logic required)
            ' xlSheet.Cells(i, 2).Value = ParseSeverity(olMail.Body)
            ' xlSheet.Cells(i, 3).Value = ParseType(olMail.Body)

            xlSheet.Cells(i, 4).Value = olMail.ReceivedTime
            i = i + 1
        End If
    Next olMail

    xlWB.SaveAs "C:\Path\To\Save\AdvisoryReport.xlsx" 'Ensure path exists or adjust accordingly
    xlWB.Close
    xlApp.Quit

    MsgBox "Export Completed"
End Sub