Internet Explorer History List in Excel

erik.van.geit

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
Hi, gurus,

How can we get a list of the IE-history of the current day (or the past day, or everything) in Excel?

can somebody point me in a good direction ?

it's a pleasure to be on this site
Erik
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
Sort by date Sort by votes
This is something I found and modified a bit for Excel from FREEVBCODE.COM. I'm sure parts of this could probably be taken out, but to be honest I'm not sure what, so I left a great deal of it alone. Hope this helps:

Code: 
Public Const ERROR_CACHE_FIND_FAIL As Long = 0
Public Const ERROR_CACHE_FIND_SUCCESS As Long = 1
Public Const ERROR_FILE_NOT_FOUND As Long = 2
Public Const ERROR_ACCESS_DENIED As Long = 5
Public Const ERROR_INSUFFICIENT_BUFFER As Long = 122
Public Const MAX_PATH As Long = 260
Public Const MAX_CACHE_ENTRY_INFO_SIZE As Long = 4096

Public Const LMEM_FIXED As Long = &H0
Public Const LMEM_ZEROINIT As Long = &H40
Public Const LPTR As Long = (LMEM_FIXED Or LMEM_ZEROINIT)

Public Const NORMAL_CACHE_ENTRY As Long = &H1
Public Const EDITED_CACHE_ENTRY As Long = &H8
Public Const TRACK_OFFLINE_CACHE_ENTRY As Long = &H10
Public Const TRACK_ONLINE_CACHE_ENTRY As Long = &H20
Public Const STICKY_CACHE_ENTRY As Long = &H40
Public Const SPARSE_CACHE_ENTRY As Long = &H10000
Public Const COOKIE_CACHE_ENTRY As Long = &H100000
Public Const URLHISTORY_CACHE_ENTRY As Long = &H200000
Public Const URLCACHE_FIND_DEFAULT_FILTER As Long = NORMAL_CACHE_ENTRY Or _
                                                    COOKIE_CACHE_ENTRY Or _
                                                    URLHISTORY_CACHE_ENTRY Or _
                                                    TRACK_OFFLINE_CACHE_ENTRY Or _
                                                    TRACK_ONLINE_CACHE_ENTRY Or _
                                                    STICKY_CACHE_ENTRY
Private Type SYSTEMTIME
        wYear As Integer
        wMonth As Integer
        wDayOfWeek As Integer
        wDay As Integer
        wHour As Integer
        wMinute As Integer
        wSecond As Integer
        wMilliseconds As Integer
End Type
Private Type FILETIME
     dwLowDateTime As Long
     dwHighDateTime As Long
End Type

Private Type INTERNET_CACHE_ENTRY_INFO
     dwStructSize As Long
     lpszSourceUrlName As Long
     lpszLocalFileName As Long
     CacheEntryType As Long
     dwUseCount As Long
     dwHitRate As Long
     dwSizeLow As Long
     dwSizeHigh As Long
     LastModifiedTime As FILETIME
     ExpireTime As FILETIME
     LastAccessTime As FILETIME
     LastSyncTime As FILETIME
     lpHeaderInfo As Long
     dwHeaderInfoSize As Long
     lpszFileExtension As Long
     dwExemptDelta  As Long
End Type
Public Type Internet_Cache_Entry
     'dwStructSize As Long
     SourceUrlName As String
     LocalFileName As String
     'CacheEntryType  As Long
     UseCount As Long
     HitRate As Long
     Size As Long
     'dwSizeHigh As Long
     LastModifiedTime As Date
     ExpireTime As Date
     LastAccessTime As Date
     LastSyncTime As Date
     HeaderInfo As String
     'dwHeaderInfoSize As Long
     FileExtension As String
     'ExemptDelta  As Long
End Type

'==============================================================================
'   Déclarations API

Private Declare Function FileTimeToLocalFileTime Lib "KERNEL32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
Private Declare Function FileTimeToSystemTime Lib "KERNEL32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Private Declare Function LocalFileTimeToFileTime Lib "KERNEL32" (lpLocalFileTime As FILETIME, lpFileTime As FILETIME) As Long
Private Declare Function SystemTimeToFileTime Lib "KERNEL32" (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long

Private Declare Function FindFirstUrlCacheEntry Lib "Wininet.dll" _
     Alias "FindFirstUrlCacheEntryA" _
    (ByVal lpszUrlSearchPattern As String, _
     lpFirstCacheEntryInfo As Any, _
     lpdwFirstCacheEntryInfoBufferSize As Long) As Long

Private Declare Function FindNextUrlCacheEntry Lib "Wininet.dll" _
     Alias "FindNextUrlCacheEntryA" _
    (ByVal hEnumHandle As Long, _
     lpNextCacheEntryInfo As Any, _
     lpdwNextCacheEntryInfoBufferSize As Long) As Long

Private Declare Function FindCloseUrlCache Lib "Wininet.dll" _
     (ByVal hEnumHandle As Long) As Long

Public Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" _
     Alias "DeleteUrlCacheEntryA" _
    (ByVal lpszUrlName As String) As Long
     
Private Declare Sub CopyMemory Lib "KERNEL32" _
     Alias "RtlMoveMemory" _
     (pDest As Any, _
    pSource As Any, _
    ByVal dwLength As Long)

Private Declare Function lstrcpyA Lib "KERNEL32" _
    (ByVal RetVal As String, ByVal Ptr As Long) As Long
                        
Private Declare Function lstrlenA Lib "KERNEL32" _
    (ByVal Ptr As Any) As Long
    
Private Declare Function LocalAlloc Lib "KERNEL32" _
     (ByVal uFlags As Long, _
    ByVal uBytes As Long) As Long
    
Private Declare Function LocalFree Lib "KERNEL32" _
     (ByVal hMem As Long) As Long
Public Function GetURLCache(URL() As Internet_Cache_Entry, URLHistory() As Internet_Cache_Entry, Cookies() As Internet_Cache_Entry)
     Dim ICEI As INTERNET_CACHE_ENTRY_INFO
     Dim hFile As Long
     Dim cachefile As String
     Dim posUrl As Long
     Dim posEnd As Long
     Dim dwBuffer As Long
     Dim pntrICE As Long
     
     dwBuffer = 0
     ReDim URL(0)
     ReDim URLHistory(0)
     ReDim Cookies(0)
     hFile = FindFirstUrlCacheEntry(0&, ByVal 0, dwBuffer)
     If (hFile = ERROR_CACHE_FIND_FAIL) And _
        (Err.LastDllError = ERROR_INSUFFICIENT_BUFFER) Then
        pntrICE = LocalAlloc(LMEM_FIXED, dwBuffer)
        If pntrICE Then
         CopyMemory ByVal pntrICE, dwBuffer, 4
         hFile = FindFirstUrlCacheEntry(vbNullString, ByVal pntrICE, dwBuffer)
         If hFile <> ERROR_CACHE_FIND_FAIL Then
            Do
                 CopyMemory ICEI, ByVal pntrICE, Len(ICEI)
                 If (ICEI.CacheEntryType And _
                     NORMAL_CACHE_ENTRY) = NORMAL_CACHE_ENTRY Then
                 Select Case ICEI.CacheEntryType
                    Case URLHISTORY_CACHE_ENTRY + NORMAL_CACHE_ENTRY
                    ReDim Preserve URLHistory(UBound(URLHistory) + 1)
                    URLHistory(UBound(URLHistory) - 1).SourceUrlName = GetStrFromPtrA(ICEI.lpszSourceUrlName)
                    URLHistory(UBound(URLHistory) - 1).LocalFileName = GetStrFromPtrA(ICEI.lpszLocalFileName)
                    URLHistory(UBound(URLHistory) - 1).FileExtension = GetStrFromPtrA(ICEI.lpszFileExtension)
                    URLHistory(UBound(URLHistory) - 1).HeaderInfo = GetStrFromPtrA(ICEI.lpHeaderInfo)
                    URLHistory(UBound(URLHistory) - 1).HitRate = ICEI.dwHitRate
                    URLHistory(UBound(URLHistory) - 1).ExpireTime = FileTime2SystemTime(ICEI.ExpireTime)
                    URLHistory(UBound(URLHistory) - 1).LastAccessTime = FileTime2SystemTime(ICEI.LastAccessTime)
                    URLHistory(UBound(URLHistory) - 1).LastModifiedTime = FileTime2SystemTime(ICEI.LastModifiedTime)
                    URLHistory(UBound(URLHistory) - 1).LastSyncTime = FileTime2SystemTime(ICEI.LastSyncTime)
                    URLHistory(UBound(URLHistory) - 1).Size = ICEI.dwSizeHigh * 2 ^ 32 + ICEI.dwSizeLow
                    URLHistory(UBound(URLHistory) - 1).UseCount = ICEI.dwUseCount
                    Case COOKIE_CACHE_ENTRY + NORMAL_CACHE_ENTRY
                    ReDim Preserve Cookies(UBound(Cookies) + 1)
                    Cookies(UBound(Cookies) - 1).SourceUrlName = GetStrFromPtrA(ICEI.lpszSourceUrlName)
                    Cookies(UBound(Cookies) - 1).LocalFileName = GetStrFromPtrA(ICEI.lpszLocalFileName)
                    Cookies(UBound(Cookies) - 1).FileExtension = GetStrFromPtrA(ICEI.lpszFileExtension)
                    Cookies(UBound(Cookies) - 1).HeaderInfo = GetStrFromPtrA(ICEI.lpHeaderInfo)
                    Cookies(UBound(Cookies) - 1).HitRate = ICEI.dwHitRate
                    Cookies(UBound(Cookies) - 1).ExpireTime = FileTime2SystemTime(ICEI.ExpireTime)
                    Cookies(UBound(Cookies) - 1).LastAccessTime = FileTime2SystemTime(ICEI.LastAccessTime)
                    Cookies(UBound(Cookies) - 1).LastModifiedTime = FileTime2SystemTime(ICEI.LastModifiedTime)
                    Cookies(UBound(Cookies) - 1).LastSyncTime = FileTime2SystemTime(ICEI.LastSyncTime)
                    Cookies(UBound(Cookies) - 1).Size = ICEI.dwSizeHigh * 2 ^ 32 + ICEI.dwSizeLow
                    Cookies(UBound(Cookies) - 1).UseCount = ICEI.dwUseCount
                    Case Else
                    ReDim Preserve URL(UBound(URL) + 1)
                    URL(UBound(URL) - 1).SourceUrlName = GetStrFromPtrA(ICEI.lpszSourceUrlName)
                    URL(UBound(URL) - 1).LocalFileName = GetStrFromPtrA(ICEI.lpszLocalFileName)
                    URL(UBound(URL) - 1).FileExtension = GetStrFromPtrA(ICEI.lpszFileExtension)
                    URL(UBound(URL) - 1).HeaderInfo = GetStrFromPtrA(ICEI.lpHeaderInfo)
                    URL(UBound(URL) - 1).HitRate = ICEI.dwHitRate
                    URL(UBound(URL) - 1).ExpireTime = FileTime2SystemTime(ICEI.ExpireTime)
                    URL(UBound(URL) - 1).LastAccessTime = FileTime2SystemTime(ICEI.LastAccessTime)
                    URL(UBound(URL) - 1).LastModifiedTime = FileTime2SystemTime(ICEI.LastModifiedTime)
                    URL(UBound(URL) - 1).LastSyncTime = FileTime2SystemTime(ICEI.LastSyncTime)
                    URL(UBound(URL) - 1).Size = ICEI.dwSizeHigh * 2 ^ 32 + ICEI.dwSizeLow
                    URL(UBound(URL) - 1).UseCount = ICEI.dwUseCount
               
                 End Select
                 End If
                 Call LocalFree(pntrICE)
                 dwBuffer = 0
                 Call FindNextUrlCacheEntry(hFile, ByVal 0, dwBuffer)
                 pntrICE = LocalAlloc(LMEM_FIXED, dwBuffer)
                 CopyMemory ByVal pntrICE, dwBuffer, 4
            Loop While FindNextUrlCacheEntry(hFile, ByVal pntrICE, dwBuffer)
         End If 'hFile
        End If 'pntrICE
     End If 'hFile
     Call LocalFree(pntrICE)
     Call FindCloseUrlCache(hFile)
End Function

Private Function GetStrFromPtrA(ByVal lpszA As Long) As String
     GetStrFromPtrA = String$(lstrlenA(ByVal lpszA), 0)
     Call lstrcpyA(ByVal GetStrFromPtrA, ByVal lpszA)
End Function

Private Function FileTime2SystemTime(FileT As FILETIME) As Date
Dim SysT As SYSTEMTIME
FileTimeToLocalFileTime FileT, FileT
FileTimeToSystemTime FileT, SysT
FileTime2SystemTime = TimeSerial(SysT.wHour, SysT.wMinute, SysT.wSecond) + DateSerial(SysT.wYear, SysT.wMonth, SysT.wDay)
End Function

Public Function DeleteUrlCache(liste() As Internet_Cache_Entry) As Boolean
Dim x As Long

For x = LBound(liste) To UBound(liste) - 1
DeleteUrlCache = DeleteUrlCacheEntry(liste(x).SourceUrlName)
Next x
End Function



Public Function deleteselecteditem(selecteditem$) As Boolean

deleteselecteditem = DeleteUrlCacheEntry(selecteditem)

End Function

Sub getcachentry()
sdate = Int(Now())
Dim xdate As Date
Range("A1:A" & Range("A65536").End(xlUp).Row).ClearContents
Dim URL() As Internet_Cache_Entry
Dim URLHistory() As Internet_Cache_Entry
Dim Cookies() As Internet_Cache_Entry
x = GetURLCache(URL(), URLHistory(), Cookies())

For N = 1 To UBound(URLHistory)
x = InStr(URLHistory(N).SourceUrlName, "@")
xurl = Right(URLHistory(N).SourceUrlName, Len(URLHistory(N).SourceUrlName) - x)
If x > 0 Then
xcontent = Mid(xurl, x, 23)

xdate = DateValue(URLHistory(N).LastAccessTime)
If xdate = sdate And Left$(xurl, 4) = "http" And Right(xurl, 3) <> "gif" And Right(xurl, 3) <> "jpg" And Right(xurl, 3) <> "zip" Then
 
i = i + 1

Range("A" & i) = Mid(URLHistory(N).SourceUrlName, InStr(1, URLHistory(N).SourceUrlName, "@") + 1)


End If
End If
Next N

Columns(1).AutoFit

End Sub
 
Upvote 0
Thank you Hotpepper,
I'm really very glad :) :) :) because this is meant to help some people from enslavement to Internet in general and more specific to the fact they can't stop surfing and even more specific to the fact that they would like to stop viewing certain pages like sex, porno or violence. They know they can't do this on their own, so with this tool they could stay accountable for persons of their choice.

It works well on my system too.
Excel XP on Windows 98SE

Could you tell me where you got it from?

I will search for items that can be taken out, for possibilities to list the complete history or a certain date (not only today) and other options.


kind regards,
Erik
 
Upvote 0
This will produce a shorter list...
(no "subpages" displayed)

Code: 
Sub getcachentry()
sdate = Int(Now())
Dim xdate As Date
Range("A1:A" & Range("A65536").End(xlUp).Row).ClearContents
Dim URL() As Internet_Cache_Entry
Dim URLHistory() As Internet_Cache_Entry
Dim Cookies() As Internet_Cache_Entry
x = GetURLCache(URL(), URLHistory(), Cookies())

Range("A1") = "VIEWED INTERNETPAGES"
fr = Range("A65536").End(xlUp).Offset(1, 0).Row
Cells(fr, 1) = Application.UserName & " " & Now

For N = 1 To UBound(URLHistory)
x = InStr(URLHistory(N).SourceUrlName, "@")
xurl = Right(URLHistory(N).SourceUrlName, Len(URLHistory(N).SourceUrlName) - x)

  If x > 0 Then
  xcontent = Mid(xurl, x, 23)
  xdate = DateValue(URLHistory(N).LastAccessTime)
    If xdate = sdate And Left$(xurl, 4) = "http" And Right(xurl, 3) <> "gif" And Right(xurl, 3) <> "jpg" And Right(xurl, 3) <> "zip" Then
    Range("A65536").End(xlUp).Offset(1, 0) = Mid(URLHistory(N).SourceUrlName, InStr(1, URLHistory(N).SourceUrlName, "@") + 1)
    End If
  End If
Next N

lr = Range("A65536").End(xlUp).Row
Set rng = Range(Cells(fr + 1, 1), Cells(lr, 1))
rng.Sort Key1:=Range("A2")
rng.Interior.ColorIndex = 0

For Each cell In rng
If cell.Interior.ColorIndex <> 6 Then
mem = cell
cell.Value = ""
    Set c = rng.Find(mem, LookIn:=xlValues)
    If Not c Is Nothing Then
    firstAddress = c.Address
      Do
      c.Interior.ColorIndex = 6
      Set c = rng.FindNext(c)
      Loop While Not c Is Nothing And c.Address <> firstAddress
    Else
    End If
cell.Value = mem
End If
Next cell

For i = lr To fr Step -1
If Cells(i, 1).Interior.ColorIndex = 6 Then Cells(i, 1).Delete
Next i

For Each cell In rng
ActiveSheet.Hyperlinks.Add Anchor:=cell, Address:=cell, TextToDisplay:=cell.Text
Next cell

Columns(1).AutoFit
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Solved
Excel Selenium VBA - Help with loop when class appears more than once
Replies
3
Views
233
Anthony47
A
N
  • Question Question
How to import specific data from Windows Explorer details list? (Image focal length information)
Replies
1
Views
136
felixstraube
F
S
  • Question Question
Not seeing latest version of data in Shared workbook
Replies
1
Views
52
Micron
M
A
  • Solved
Update Excel Online automatically when new entry added to SharePoint list
Replies
5
Views
408
Joe4
Joe4
A
  • Question Question
Automate Attendance Marking Based on Daily Schedule in Excel
Replies
1
Views
223
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,224,270
Messages
6,177,574
Members
452,784
Latest member
talippo

Share this page

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