Recently Used File List - Simplofied

Category:

Files and Directories

Type:

Snippets

Difficulty:

Intermediate

Author: Anonymous

Version Compatibility: Visual Basic 6

More information:

The purpose of this submission is just another way to list recently used file items in your application. The other submissions on this site seem pretty complicated and not very complete.

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
' (None)

Code:

'This snippet assumes the following:
'1. You have a file menu item, I would call mnuFileMain
'2. One item is a seperator, mnuFileSep, which should be initialized to mnuFileSep.Visible = False
'3. One other item is mnuFileRUFL(0), a control array item, whose beginning index is 0, also initialized to mnuFileRUFL(0).Visible = False
'4. Other items on File Menu are: mnuFileOpen, mnuFileSave, mnuFileSaveAs, mnuFileExit whose enabled properties should be specified under program conditions, ie: valid information available, etc.
'5. A common dialog control name dlgDialog

'One feature of this method is the Short File Name procedure at the end, which condenses the file name for display purposes, pretty handy

Option Explicit

Const FileExt as String = ".ext"

Dim FileInfo as Variant 'this is some generic information, I would suggest using a User-Defined type, of course
Dim FileName as String 'global variable which contains the current file name being used - helpful for Save or Save As condition, ie: if a file is open, then Save would work without displaying the Dialog again.
Dim ChangesMade as Boolean 'global variable which should be set at any change to file information - helpful when a user may accidentally lose information by not saving first

Private Sub AddFileToRUFL(FileName As String)
    Dim FileCount As Integer
    Dim SwapCount As Integer
    Dim ShortName As String
    Dim Settings(1 To 9, 1 To 2) As String
    Dim FileExists As Boolean
    ShortName = ShortenFileName(FileName)
    'first properly load array
    For FileCount = 1 To 9
        Settings(FileCount, 1) = Format(FileCount)
        Settings(FileCount, 2) = GetSetting(App.EXEName, "RUFL", Format(FileCount), "<Empty>")
    Next FileCount
    'next check to see if filename already exists
    For FileCount = 1 To 9
        If Settings(FileCount, 2) = ShortName & "|" & FileName Then
            'if exists, swap down at location to move to top priority
            For SwapCount = FileCount To 2 Step -1
                Settings(SwapCount, 2) = Settings(SwapCount - 1, 2)
            Next SwapCount
            Settings(1, 2) = ShortName & "|" & FileName
            FileExists = True
            Exit For
        End If
    Next FileCount
    If Not FileExists Then
        For FileCount = 9 To 2 Step -1
            'move each file down one, add to top priority
            Settings(FileCount, 2) = Settings(FileCount - 1, 2)
        Next FileCount
        Settings(1, 2) = ShortName & "|" & FileName
    End If
    're-save/save all settings to registry
    For FileCount = 1 To 9
        SaveSetting App.EXEName, "RUFL", Settings(FileCount, 1), Settings(FileCount, 2)
    Next FileCount
    AdjustRUFL
End Sub

Private Sub RemoveFileFromRUFL(FileName As String)
    Dim FileCount As Integer
    Dim SwapCount As Integer
    Dim ShortName As String
    Dim Settings(1 To 9, 1 To 2) As String
    Dim FileExists As Boolean
    ShortName = ShortenFileName(FileName)
    'first properly load array
    For FileCount = 1 To 9
        Settings(FileCount, 1) = Format(FileCount)
        Settings(FileCount, 2) = GetSetting(App.EXEName, "RUFL", Format(FileCount), "<Empty>")
    Next FileCount
    'next check to find filename
    For FileCount = 1 To 9
        If Settings(FileCount, 2) = ShortName & "|" & FileName Then
            'if exists, swap down to move this to top priority
            For SwapCount = FileCount To 8
                Settings(SwapCount, 2) = Settings(SwapCount + 1, 2)
            Next SwapCount
            Settings(9, 2) = "<Empty>"
            Exit For
        End If
    Next FileCount
    're-save/save all settings to registry
    For FileCount = 1 To 9
        SaveSetting App.EXEName, "RUFL", Settings(FileCount, 1), Settings(FileCount, 2)
    Next FileCount
    AdjustRUFL
End Sub

Private Sub mnuFileRUFL_Click(Index As Integer)
    Dim Object As Object
    Set Object = CreateObject("Scripting.FileSystemObject")
    If ChangesMade Then
        Select Case MsgBox("Changes have been made, do you want to save first?", vbQuestion Or vbYesNoCancel, "Save?")
            Case vbYes
                Call mnuFileSave_Click
            Case vbNo
            Case vbCancel
                Exit Sub
        End Select
    End If
    If Object.FileExists(mnuFileRUFL(Index).Tag) Then
        If Not OpenFile(mnuFileRUFL(Index).Tag) Then 'failed to open
            If MsgBox("Trouble opening listed file, remove from list?", vbQuestion Or vbYesNo, "Remove Listed File?") = vbYes Then
                RemoveFileFromRUFL mnuFileRUFL(Index).Tag
            End If
        End If
    ElseIf MsgBox("Trouble opening listed file, remove from list?", vbQuestion Or vbYesNo, "Remove Listed File?") = vbYes Then
        RemoveFileFromRUFL mnuFileRUFL(Index).Tag
    End If
End Sub

Private Sub mnuFileOpen_Click()
    On Error GoTo abort
    Dim TempName As String
    If ChangesMade Then
        Select Case MsgBox("Changes have been made, do you want to save first?", vbQuestion Or vbYesNoCancel, "Save Before Opening?")
            Case vbYes
                Call mnuFileSave_Click
            Case vbNo
            Case vbCancel
                Exit Sub
        End Select
    End If
    With dlgDialog
        .DefaultExt = FileExt
        .CancelError = True
        .DialogTitle = "Open File..."
        .Filter = "Files (*." & FileExt & ")|*." & FileExt
        .InitDir = App.Path 'change later
        .Flags = cdlOFNExplorer Or cdlOFNHideReadOnly Or _
            cdlOFNLongNames Or cdlOFNPathMustExist Or cdlOFNNoReadOnlyReturn Or _
            cdlOFNFileMustExist
    End With
    dlgDialog.ShowOpen
    TempName = Left(dlgDialog.FileName, InStrRev(dlgDialog.FileName, ".")) & FileExt
    OpenFile TempName
    Exit Sub
abort:
End Sub

Private Sub mnuFileSave_Click()
    On Error GoTo abort
    Dim FileNum As Byte
    If FileName <> "" Then
        FileNum = FreeFile
        Open FileName For Binary As FileNum
        Put FileNum, 1, FileInfo
        Close FileNum
        ChangesMade = False
        AddFileToRUFL FileName
    Else
        Call mnuFileSaveAs_Click
    End If
    Exit Sub
abort:
    If Err.Number <> cdlCancel Then
        If MsgBox(Err.Description, vbCritical Or vbRetryCancel, "Error Occurred!") = vbRetry Then
            Resume
        Else
            Close FileNum
        End If
    End If
End Sub

Private Sub mnuFileSaveAs_Click()
    On Error GoTo abort
    Dim FileNum As Byte
    With dlgDialog
        .DefaultExt = FileExt
        .CancelError = True
        .DialogTitle = "Save File As..."
        .Filter = "Files (*." & FileExt & ")|*." & FileExt
        .InitDir = App.Path
        .Flags = cdlOFNExplorer Or cdlOFNHideReadOnly Or _
            cdlOFNLongNames Or cdlOFNOverwritePrompt Or cdlOFNPathMustExist Or _
            cdlOFNNoReadOnlyReturn
    End With
    dlgDialog.ShowSave
    FileName = Left(dlgDialog.FileName, InStrRev(dlgDialog.FileName, ".")) & FileExt
    FileNum = FreeFile
    Open FileName For Binary As FileNum
    Put FileNum, 1, FileInfo
    Close FileNum
    ChangesMade = False
    AddFileToRUFL FileName
    Exit Sub
abort:
    If Err.Number <> cdlCancel Then
        If MsgBox(Err.Description, vbCritical Or vbRetryCancel, "Error Occurred!") = vbRetry Then
            Resume
        Else
            Close FileNum
        End If
    End If
End Sub

Private Sub AdjustRUFL(Optional DestroyRUFL As Boolean = False)
    On Error Resume Next
    Dim FileCount As Integer
    Dim FileName As String
    Dim FileNames() As String
    mnuFileSep.Visible = False
    For FileCount = 1 To 9
        FileName = GetSetting(App.EXEName, "RUFL", "File" & Format(FileCount), "<Empty>")
        If FileName <> "<Empty>" And Not DestroyRUFL Then
            FileNames = Split(FileName, "|")
            mnuFileSep.Visible = True
            Load mnuFileRUFL(FileCount)
            mnuFileRUFL(FileCount).Caption = "&" & Format(FileCount) & ". " & FileNames(0) 'short
            mnuFileRUFL(FileCount).Tag = FileNames(1) 'absolute file path
            mnuFileRUFL(FileCount).Visible = True
        Else
            Unload mnuFileRUFL(FileCount)
        End If
    Next FileCount
End Sub

Public Function OpenFile(FileName As String) As Boolean
    On Error GoTo abort
    Dim FileNum As Byte
    FileNum = FreeFile
    Open FileName For Binary As FileNum
    'here you would add all your specific file-loading
    mnuFileSave.Enabled = True
    mnuFileSaveAs.Enabled = True
    ChangesMade = False
    AddFileToRUFL FileName
    OpenFile = True 'indicates success
    Exit Function
abort:
    If MsgBox(Err.Description, vbCritical Or vbRetryCancel, "Error Occurred!") = vbRetry Then
        Resume
    Else
        Close FileNum
    End If
End Function

Private Sub mnuFileExit_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    AdjustRUFL 'initialize menu if any items are in the registry
    ChangesMade = False
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If ChangesMade Then
        Select Case MsgBox("Changes have been made, do you want to save first?", vbQuestion Or vbYesNoCancel, "Save Before Exiting?")
            Case vbYes
                Call mnuFileSave_Click
            Case vbNo
            Case vbCancel
                Cancel = 1 'prevent exit
        End Select
    End If
    AdjustRUFL True 'be sure to destroy any loaded RUFL items
End Sub

'Purpose: shorten an absolute file name to a printable file name
'Receives: FileName (String) - an absolute file name
'Returns: String - shortened file name with intermediate colons Ex: C:\..\..\Filename.ext
Private Function ShortenFileName(FileName As String) As String
    Dim PathSepLoc As Integer
    Dim FileStrings() As String
    FileStrings = Split(FileName, "\")
    'get drive name
    ShortenFileName = ShortenFileName & FileStrings(0) & "\"
    For PathSepLoc = 1 To UBound(FileStrings) - 1
        'add intermediate colons
        ShortenFileName = ShortenFileName & "..\"
    Next PathSepLoc
    'get actual file name without path
    ShortenFileName = ShortenFileName & FileStrings(UBound(FileStrings))
End Function