'Uses early binding so needs reference to Microsoft Shell Controls and Automation.
Option Explicit
Public Sub Dump_IE_History()
Dim shell As New Shell32.shell
Dim historyFolder As Shell32.Folder3
Dim timePeriodItem As Shell32.folderItem
Dim timePeriodName As String, prevTimePeriod As String
Dim internetHostItem As Shell32.folderItem
Dim internetHostName As String, prevInternetHostName As String
Dim urlFolder As Shell32.folder
Dim urlItem As Shell32.folderItem
Dim URL As String, title As String, timeLastVisited As String
Dim arr As Range
Dim headings As Variant
Dim rowOffset As Long
'Define the starting cell where the data will be dumped
Set arr = ActiveSheet.Range("A1")
arr.Parent.Cells.ClearContents
Set historyFolder = shell.Namespace(Shell32.ShellSpecialFolderConstants.ssfHISTORY)
rowOffset = 0
arr.Offset(rowOffset, 0).Value = "IE history folder"
arr.Offset(rowOffset, 1).Hyperlinks.Add anchor:=arr.Offset(rowOffset, 1), Address:=historyFolder.Self.Path, _
TextToDisplay:=historyFolder.Self.Path
headings = Array("Time Period", "Internet Host", "Internet Address", "Title", "Last Visited")
rowOffset = rowOffset + 2
arr.Offset(rowOffset, 0).Resize(1, UBound(headings) + 1).Value = headings
prevTimePeriod = ""
For Each timePeriodItem In historyFolder.Items
timePeriodName = timePeriodItem.Name
If timePeriodName <> prevTimePeriod Then
rowOffset = rowOffset + 1
arr.Offset(rowOffset, 0).Value = timePeriodName
End If
prevInternetHostName = ""
For Each internetHostItem In timePeriodItem.GetFolder.Items
internetHostName = internetHostItem.Name
If internetHostName <> prevInternetHostName Then
arr.Offset(rowOffset, 1).Value = internetHostName
prevInternetHostName = internetHostName
End If
Set urlFolder = internetHostItem.GetFolder
For Each urlItem In urlFolder.Items
URL = urlFolder.GetDetailsOf(urlItem, 0)
title = urlFolder.GetDetailsOf(urlItem, 1)
timeLastVisited = urlFolder.GetDetailsOf(urlItem, 2)
arr.Offset(rowOffset, 2).Hyperlinks.Add anchor:=arr.Offset(rowOffset, 2), Address:=URL, TextToDisplay:=URL
arr.Offset(rowOffset, 3).Value = title
arr.Offset(rowOffset, 4).Value = timeLastVisited
rowOffset = rowOffset + 1
Next
Next
Next
End Sub