Creating an auto-refreshing webpage from spreadsheet

[lynnc]

Below is my code to produce an HTML page. It works but I would like to add some code that would make the page auto-refresh in the browser that it is opened in because the file may get updated. How would I make that happen?

Sub DataToHTM()
    Dim r As Excel.Range, rHTM As Excel.Range, wbk As Excel.Workbook
    Dim strFilePath As String, sht As Excel.Worksheet, blnAlertBf As Boolean
    blnAlertBf = Application.DisplayAlerts
    Application.ScreenUpdating = False
    Application.CopyObjectsWithCells = False
    Set r = Sheet1.Cells(1, 1)
    Set r = r.CurrentRegion
    r.AutoFilter
    r.AutoFilter Field:=10, Criteria1:="="
    r.Select
    r.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Range("A1").Select
    Set wbk = Workbooks.Add()
    ActiveSheet.Paste
    'Columns("A:A").EntireColumn.ColumnWidth = 24
    
    Columns("B:B").EntireColumn.ColumnWidth = 28
    Columns("C:C").EntireColumn.ColumnWidth = 15
    Columns("D:D").EntireColumn.ColumnWidth = 15
    Columns("E:E").EntireColumn.AutoFit
    Columns("F:F").EntireColumn.AutoFit
    Columns("G:G").EntireColumn.ColumnWidth = 15
    Columns("H:H").EntireColumn.ColumnWidth = 24
    Columns("I:I").EntireColumn.ColumnWidth = 15
    Columns("M:M").EntireColumn.ColumnWidth = 15
    Columns("A:A").EntireColumn.Delete
    Columns("K:K").EntireColumn.Delete
    Columns("J:J").EntireColumn.Delete
    
    
    Application.CopyObjectsWithCells = True
    
   ' Columns("H:H").EntireColumn.Delete
    Rows().EntireRow.AutoFit
    Set sht = wbk.Sheets(1)
    Set rHTM = sht.Cells(1, 1)
    Set rHTM = rHTM.CurrentRegion
    sht.ListObjects.Add(xlSrcRange, rHTM, , xlYes).Name = _
        "Table1"
    Range("Table1[#All]").Select
    sht.ListObjects("Table1").TableStyle = "TableStyleMedium10"
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1:H1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
    End With
    Selection.Merge
    Range("A1:H1").Select
    ActiveCell.FormulaR1C1 = "REPORT CREATED " & Now & vbNewLine & _
    "(Red Highlight = Past Due, Yellow = Due Today, Green = Due in 3 Days or less)"
    Range("A3").Select
    Application.DisplayAlerts = False
    For Each sht In wbk.Sheets
        If sht.Index <> 1 Then
            sht.Delete
        End If
    Next sht
    Set sht = wbk.Sheets(1)
    strFilePath = ThisWorkbook.Path
    sht.Sort.SortFields.Clear
    sht.Sort.SortFields.Add Key:=rHTM.Cells(2, 7), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortTextAsNumbers
    With sht.Sort
        .SetRange rHTM
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    wbk.SaveAs Filename:="J:\Customer Open Order Report.htm", _
        FileFormat:=xlHtml, ReadOnlyRecommended:=False, CreateBackup:=False
        ActiveWindow.Close
  Application.DisplayAlerts = blnAlertBf
End Sub