KwikOpen Update

Posted on August 31, 2016 by Dick Kusleika

A year and a half ago, I decided that I was going to make a change to my KwikOpen add-in to get rid of recent files that no longer exist. Well, I finally got it done. No, it didn’t take that long to implement. The performance of the add-in has been fine so there wasn’t a pressing need. The other day, the addin seemed a little less peppy than usual and I thought it was time for a look.

I had 2,368 files in my MRU and 465 of them are dead links. That’s about 20% and it’s similar to the proportion I saw back in February 2015. Of the three options I listed at the bottom of my previous post, I chose none of them. Instead, I weeded out some files as I wrote them back out to disk.

Public Sub WriteToDisk()
    
    Dim sFile As String
    Dim lFile As Long
    Dim clsRcntFile As CRcntFile
    Dim aFiles(1 To 3000) As String
    Dim lFileCnt As Long
    Dim lWriteCnt As Long
        
    Const dWEEDLIMIT As Double = 0.9
    
    For Each clsRcntFile In Me
        lFileCnt = lFileCnt + 1
        If lFileCnt < Me.Count * dWEEDLIMIT Or clsRcntFile.Exists Then
            lWriteCnt = lWriteCnt + 1
            aFiles(lWriteCnt) = clsRcntFile.FullName
        End If
        If lWriteCnt >= UBound(aFiles) Then Exit For
    Next clsRcntFile
    
    sFile = Environ$("APPDATA") & "\Microsoft\Addins\" & msMRUFILE
    lFile = FreeFile
    
    Open sFile For Output As lFile
    Print #lFile, Join(aFiles, vbNewLine)
    Close lFile
    
End Sub

Public Sub WriteToDisk()

Dim sFile As String

Dim lFile As Long

Dim clsRcntFile As CRcntFile

Dim aFiles(1 To 3000) As String

Dim lFileCnt As Long

Dim lWriteCnt As Long

Const dWEEDLIMIT As Double = 0.9

For Each clsRcntFile In Me

lFileCnt = lFileCnt + 1

If lFileCnt < Me.Count * dWEEDLIMIT Or clsRcntFile.Exists Then

lWriteCnt = lWriteCnt + 1

aFiles(lWriteCnt) = clsRcntFile.FullName

End If

If lWriteCnt >= UBound(aFiles) Then Exit For

Next clsRcntFile

sFile = Environ$("APPDATA") & "\Microsoft\Addins\" & msMRUFILE

lFile = FreeFile

Open sFile For Output As lFile

Print #lFile, Join(aFiles, vbNewLine)

Close lFile

End Sub

The file names are written to the file with the most recent at the top – sort of. Because I’m using the built-in MRU as well as my own, it’s not exactly that way, but it’s close enough for government work. Instead of time stamping the entries, I decided to dump any nonexistent files that were near the bottom of the list. If a file is in the top 90% of the list, it stays regardless of whether it exists. If it’s in the bottom 10%, it only stays if it’s still where it was.

Iteration	Total Files	Orphaned Files
Beg.	2,368	465
1	2,250	345
2	2,226	321
3	2,225	320

Looking at the last 100 or so files, they’re mostly from 2014. I could cap this at 2,000 and probably not notice.

3 thoughts on “KwikOpen Update”

Turns out that checking whether the file exists in a loop adds about 2000 milliseconds to the operation. That’s not happening, so I updated the WriteToDisk method.

<pre>Public Sub WriteToDisk()

    Dim sFile As String
    Dim lFile As Long
    Dim clsRcntFile As CRcntFile
    Dim aFiles(1 To 3000) As String
    Dim lFileCnt As Long
    Dim lWriteCnt As Long

    Const dWEEDLIMIT As Double = 0.9

    If gcTimer Is Nothing Then Set gcTimer = New CTimer
    gcTimer.StartCounter

    sFile = Environ$("APPDATA") & "\Microsoft\Addins\" & msMRUFILE

    If Date > Int(FileDateTime(sFile)) Then
        For Each clsRcntFile In Me
            lFileCnt = lFileCnt + 1
            If lFileCnt < (Me.Count * dWEEDLIMIT) Or clsRcntFile.Exists Then
                lWriteCnt = lWriteCnt + 1
                aFiles(lWriteCnt) = clsRcntFile.FullName
            End If
            If lWriteCnt >= UBound(aFiles) Then Exit For
        Next clsRcntFile
    Else
        For Each clsRcntFile In Me
            lWriteCnt = lWriteCnt + 1
            aFiles(lWriteCnt) = clsRcntFile.FullName
            If lWriteCnt >= UBound(aFiles) Then Exit For
        Next clsRcntFile
    End If

    gcTimer.Split "Fill Array"

    lFile = FreeFile

    Open sFile For Output As lFile
    Print #lFile, Join(aFiles, vbNewLine)
    Close lFile

    gcTimer.Split "Write file"
    gcTimer.StopCounter

End Sub

<pre>Public Sub WriteToDisk()

Dim sFile As String

Dim lFile As Long

Dim clsRcntFile As CRcntFile

Dim aFiles(1 To 3000) As String

Dim lFileCnt As Long

Dim lWriteCnt As Long

Const dWEEDLIMIT As Double = 0.9

If gcTimer Is Nothing Then Set gcTimer = New CTimer

gcTimer.StartCounter

sFile = Environ$("APPDATA") & "\Microsoft\Addins\" & msMRUFILE

If Date > Int(FileDateTime(sFile)) Then

For Each clsRcntFile In Me

lFileCnt = lFileCnt + 1

If lFileCnt < (Me.Count * dWEEDLIMIT) Or clsRcntFile.Exists Then

lWriteCnt = lWriteCnt + 1

aFiles(lWriteCnt) = clsRcntFile.FullName

End If

If lWriteCnt >= UBound(aFiles) Then Exit For

Next clsRcntFile

Else

For Each clsRcntFile In Me

lWriteCnt = lWriteCnt + 1

aFiles(lWriteCnt) = clsRcntFile.FullName

If lWriteCnt >= UBound(aFiles) Then Exit For

Next clsRcntFile

End If

gcTimer.Split "Fill Array"

lFile = FreeFile

Open sFile For Output As lFile

Print #lFile, Join(aFiles, vbNewLine)

Close lFile

gcTimer.Split "Write file"

gcTimer.StopCounter

End Sub

With

If Date > Int(FileDateTime(sFile)) Then

1	If Date > Int(FileDateTime(sFile)) Then

it only does the expensive operation the first time it writes to the disk that day.

JoeC says:

May 20, 2017 at 6:55 pm

would you post a version of the updated kwikopen that is an add-in like in the comments here?

http://dailydoseofexcel.com/archives/2015/02/11/weeding-the-kwikopen-garden/

If appropriate, how about a HOW-TO on how to get to the add-in?

Thank you.

JoeC
Dick Kusleika says:

May 22, 2017 at 8:24 am

It can be found here

http://dailydoseofexcel.com/excel/KwikOpen.zip

Unzip and put the xlam file anywhere you want. From Excel, File – Options – Addins – Manage Excel Add-ins – Go. Browse to xlam file. OK.

Now Ctrl+O and Ctrl+Shft+S will be work differently. If you don’t already have KwikOpenFiles.txt in your My Documents directory, you will now.