Internet History in Excel Cells using VBA

sanits591

Active Member
Joined
May 30, 2010
Messages
253
Hi,

I want to have the internet history accessed in excel files using vba mentioning the date and URL in cells

Request to have the VBA code for this, i want an alternate to Internet options and then accessing the history.

Please help!

Thanks!
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
I can't get that code to abend at all and I see that someone else has got it running okay. The URL you gave me is, suspiciously, 1023 bytes in length and this leads me to suspect that you may have hit a limit of some sort, but I can't test it because I don't have any URLs of this length in my cache.

All I can suggest for the moment is that you try wrapping the statement which causes the failure in an On Error clause, like so:-
Code:
      [COLOR=red][B]On Error Resume Next
[/B][/COLOR]      Set c = Rng.Find(mem, LookIn:=xlValues)
      [COLOR=red][B]On Error GoTo 0
[/B][/COLOR]
All that bit of the code is doing is looking for duplicates by the looks of it, so the worse thing that can happen is that you end up with a few dupes - I think!

When you say you got this code from a friend, do you mean that he wrote it? If so, I think your next step would be to contact him and ask him to look at his coding again; if not, knowing where it came from might help as there may be some useful contect on the Web site and/or you might be able to contact the original author.
 
Upvote 0
I want to have the internet history accessed in excel files using vba mentioning the date and URL in cells
Try this. As noted in the comment at the top of the code, you need to set a reference to Microsoft Shell Controls and Automation, otherwise the code won't compile. Set this in the VB editor via the Tools - References menu.
Code:
'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
 
Last edited:
Upvote 0
Glad it helps. Here's version 1.1, which dumps the IE history to "Sheet1" and removes 2 or 3 unnecessary lines.
Code:
'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 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
    
    Sheets("Sheet1").Activate
    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
    
    For Each timePeriodItem In historyFolder.Items
    
        rowOffset = rowOffset + 1
        arr.Offset(rowOffset, 0).Value = timePeriodItem.Name
        
        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

Using the same Shell Controls objects, here's a procedure which dumps the IE cache (temporary Internet files) to "Sheet2":
Code:
Public Sub Dump_IE_Cache()

    Dim shell As New Shell32.shell
    Dim cacheFolder As Shell32.Folder3
    Dim item As Shell32.folderItem
    Dim arr As Range
    Dim headings As Variant
    Dim rowOffset As Long
    Dim url As String
    Dim i As Long
    
    'Define the starting cell where the data will be dumped
    
    Sheets("Sheet2").Activate
    Set arr = ActiveSheet.Range("A1")
    arr.Parent.Cells.ClearContents
    
    Set cacheFolder = shell.Namespace(Shell32.ShellSpecialFolderConstants.ssfINTERNETCACHE)
    
    rowOffset = 0
    arr.Offset(rowOffset, 0).Value = cacheFolder.title
    arr.Offset(rowOffset, 1).Hyperlinks.Add anchor:=arr.Offset(rowOffset, 1), Address:=cacheFolder.Self.Path, _
        TextToDisplay:=cacheFolder.Self.Path
    
    headings = Array("Name", "Internet Address", "Type", "Size", "Expires", "Last Modified", "Last Accessed", "Last Checked")
    rowOffset = rowOffset + 2
    arr.Offset(rowOffset, 0).Resize(1, UBound(headings) + 1).Value = headings
    
    For Each item In cacheFolder.Items               
        rowOffset = rowOffset + 1
        arr.Offset(rowOffset, 0).Value = cacheFolder.GetDetailsOf(item, 0)
        
        url = cacheFolder.GetDetailsOf(item, 1)
        If InStr(url, "http") = 1 Then
            arr.Offset(rowOffset, 1).Hyperlinks.Add anchor:=arr.Offset(rowOffset, 1), Address:=url, TextToDisplay:=url
        Else
            arr.Offset(rowOffset, 1).Value = url
        End If
        
        For i = 2 To 7
            arr.Offset(rowOffset, i).Value = cacheFolder.GetDetailsOf(item, i)
        Next
    Next

End Sub
 
Upvote 0

Forum statistics

Threads
1,225,156
Messages
6,183,221
Members
453,152
Latest member
ChrisMd

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top