Streamlining Form VBA External Files List HyperLinks ~ LEARN MS-ACCESS TIPS AND TRICKS

External Files List in Hyperlinks in Form.

The Office.FileDialog Control

The FileDialog Control displays files from the selected folder as hyperlinks in the form. Clicking on a hyperlink will open the file in its native application, if available.

The File Dialog control features user-defined filters that allow users to display specific categories of files, such as Word Documents, Excel Worksheet files, and Access Databases, or view all files within a folder. Select the required files and click on the 'Create File Link' Command Button to add the selected files to a table and display them in the form in Datasheet View as hyperlinks. The full file pathnames are shown in the second column for reference.

Files' List Display Image.

After setting the File Filter in the TextBox with the name Pathname, Click on the Create File Links Command Button to open the following File Browser control to display the Files and Folders.

At this point, you can select any folder to search for files if needed. To select several adjoining files, click on the first file, hold the Shift key, click on the last file, and then click the 'Open' command button. The selected files will appear in the list, as shown in the first image.

The Form Module VBA Code.

Option Compare Database
Option Explicit

Private FD As New FLst_Object_Init

Private Sub Form_Load()
    Set FD.fl_Frm = Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
Set FD = Nothing
End Sub

In the Global Declaration area, the Class_Init Class Module with the name FLst_Object_Init Object is declared with the name FD. An Instance of the Object is created in memory using the keyword New in the declaration.

In the Form_Load() Event Procedure the current Form Object is passed to the FD.fl_Frm Property to the FD Object Instance.

The FLst_Object_Init Class Module Code.

The FLst_Object_Init with the Class_Init() Subroutine VBA Code is given below:

Option Compare Database
Option Explicit

Private cmd As FLst_CmdButton
Private frm As Access.Form
Private Coll As New Collection

'------------------------------------------------------
'Streamlining Form Module Code
'in Stand-alone Class Modules
'------------------------------------------------------
'Disk Directory Listing in Hyperlinks
'Author: a.p.r. pillai
'Date  : 25/10/2023
'Rights: All Rights(c) Reserved by www.msaccesstips.com
'------------------------------------------------------

Public Property Get fl_Frm() As Access.Form
    Set fl_Frm = frm.m_cFrm
End Property

Public Property Set fl_Frm(ByRef pNewValue As Access.Form)
    Set frm = pNewValue
    
    Call Class_Init
End Property

Private Sub Class_Init()
Dim ctl As Control
Dim listcount As Long
Const EP = "[Event Procedure]"

'=============================
'Calling the Public Function ButtonStatus() From FLst_CmdButton Class
'from the Flst_CmdButton Class directly,
Set cmd = New FLst_CmdButton 'Create a separate instance
Set cmd.cmd_Frm = frm 'Pass the Form Object to the Property

Call cmd.ButtonStatus 'Call the Public Function, with Param, if any
Set cmd = Nothing 'Remove the instance
'=============================

For Each ctl In frm.Controls
Select Case TypeName(ctl)
      Case "CommandButton"
        Select Case ctl.Name
            Case "cmdHelp", "cmdFileDialog", _
            "cmdDelLink", "cmdDelFile", _
            "cmdClose", "cmdDelAll"
            
                Set cmd = New FLst_CmdButton
                Set cmd.cmd_Frm = frm
                Set cmd.c_cmd = ctl
        
                    cmd.c_cmd.OnClick = EP
                Coll.Add cmd
                Set cmd = Nothing
        End Select
End Select
Next

End Sub

Private Sub Class_Terminate()
Do While Coll.Count > 0
    Coll.Remove 1
Loop
End Sub

The following two Subroutines, if present in the Class Module, run automatically.

Class_Initialize()
Class_Terminate()

Assume that we have both the above Subroutines in ClassA.

You create an Instance of ClassA in ClassB, like Dim A As ClassA, Set A = New ClassA. The Class_Initialize() Subroutine in ClassA runs, if present. You can put any initializing steps of Code within this Subroutine.

When you execute the Statement: Set A = Nothing or ClassB object Unloads the Class_Terminate() Subroutine in ClassA executes. You can do the clean-up work, like Set Obj = Nothing, in this Subroutine to clear memory for other use.

This is useful when other objects like Collection Object, Dictionary Object, or other Class Module declarations are present in the Class Module. The following Class1 Module is Instantiated in the Form Module.

'Class1
Dim DT As ClsDateTime

Private Sub Class_Initialize()
  Set DT = New ClsDateTime
  Forms("Form2").Text2 = DT.DateTime
End Sub

Private Sub Class_Terminate()
 Set DT = Nothing

End Sub

The Class_Initialize() Subroutine, if present in the class module, runs immediately upon instantiating the Class Object. However, in our streamlined VBA coding, we are unable to utilize this feature. This limitation arises because we need to obtain the Form Object in the Class Module before executing the Class_Init() Subroutine. Consequently, we cannot use the Class_Initialize Subroutine. Instead, we call the Class_Init() Subroutine immediately after acquiring the Form Object in the Set Property Procedure of the Form Object.

That doesn't mean that we cannot use it at all. We can use it to instantiate the Collection Object or any other Objects used in this Class Module, like the following example:

Private Sub Class_Initialize()
	Set Coll = New Collection
End Sub

The Collection Object declaration is made in the Global declaration area of the Class Module. Since we used the New keyword in the Declaration Statement these extra lines of Code are not required within the Class_Initialize() Subroutine.

The Class_Terminate() Subroutine is useful to clean up memory and works like the Form_Unload() Event Procedure.

Private Sub Class_Terminate()
Do While Coll.Count > 0
    Coll.Remove 1
Loop
End Sub

The above Code clears the Collection Object contents when the FLst_Object_Init Class Module Unloads from memory.

In this Project, we need only a single Wrapper Class Module for the Command Buttons on the Form, besides the Class Module FLst_Object_Init with the Class_Init() Subroutine.

The Command Button Class FLst_CmdButton has several subroutines and all of them are called individually from under each command Button Name from the Click Event Subroutine for clarity, rather than writing the entire Code directly under the Command Button name.

The FLst_CmdButton Class Module Code.

'The Click Event Subroutines
Private Sub cmd_Click()
Select Case cmd.Name
  Case "cmdClose"
    If MsgBox("Close this Form?", vbOKCancel + vbQuestion, "cmd_Click") = vbOK Then
        DoCmd.Close acForm, cmdfrm.Name
        Exit Sub
    End If

    Case "cmdFileDialog"
        Call cmdFileDialog 'Display selected Path & files
        
    Case "cmdDelLink"
        Call cmdDelLink 'Delete Selected Link from list
    
    Case "cmdDelAll"
        Call cmdDelAll 'Delete All Links from list
    
    Case "cmdDelFile"
        Call cmdDelFile 'Delete Link and File from Disk
        
    Case "cmdHelp"
        DoCmd.OpenForm "Help", acNormal 'Show help Form
End Select
End Sub

The cmdFileDialog() Subroutine.

This Subroutine is run by clicking on the Command Button with the Caption Create File Links.

Private Sub cmdFileDialog()
On Error GoTo cmdFileDialog_Click_Err

'Requires reference to Microsoft Office 12.0 Object Library.
Dim fDialog As office.FileDialog
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim defPath As String
Dim varFile As Variant
Dim strfiles As String

   'Set up the File Dialog.
   Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
   With fDialog
      'Allow user to make multiple selections of disk files.
      .AllowMultiSelect = True
      .InitialFileName = Dir(strPath)
      .InitialView = msoFileDialogViewDetails
      'Set the title of the dialog box.
      .Title = "Please select one or more files"

      'Clear out the current filters, and add our own.
      .Filters.Clear
      .Filters.Add "Access Databases", "*.mdb; *.accdb"
      .Filters.Add "Excel WorkBooks", "*.xlsx; *.xlsm; *.xls; *.csv"
      .Filters.Add "Word Documents", "*.docx; *.doc"
      .Filters.Add "Access Projects", "*.adp"
      .Filters.Add "All Files", "*.*"
      .FilterIndex = 1
      '.Execute
      'Show the dialog box. If the .Show method returns True, the
      'user picked at least one file. If the .Show method returns
      'False, the user clicked Cancel.
    If .Show = True Then
        Set db = CurrentDb
        Set rst = db.OpenRecordset("DirectoryList", dbOpenDynaset)
        'Add all selected files to the DirectoryList Table
        defPath = ""
      For Each varFile In .SelectedItems
         If defPath = "" Then
            defPath = Left(varFile, InStrRev(varFile, "\"))
            defPath = defPath & "*.*"
            cmdfrm.PathName = defPath
            cmdfrm.PathName.Requery
            strPath = defPath
         End If
            rst.AddNew
            'Create Hyperlink in 4 segments
            '1st segment: only the File Name
            strfiles = Mid(varFile, InStrRev(varFile, "\") + 1)
            '2nd segment:Full File PathName,3rd Empty,4th TipText
            strfiles = strfiles & "#" & varFile & "##Click"
            rst![FileLinks] = strfiles
            rst![Path] = varFile
            rst.Update
    Next
        
    Call ButtonStatus

        Else
            MsgBox "You clicked Cancel in the file dialog box."
        End If
      
   End With

cmdFileDialog_Click_Exit:
Exit Sub

cmdFileDialog_Click_Err:
MsgBox Err & " : " & Err.Description, , "cmdFileDialog_Click()"
Resume cmdFileDialog_Click_Exit
End Sub

The statement 'Set fDialog = Application.FileDialog(msoFileDialogFilePicker)' opens the File Browser Dialog Control and initializes its various properties. Within this control, we can define file type filters, allowing users to select specific file types from the filter display when the FileDialog control is open and displaying files from the default path setting. If there are any uncertainties about the file selection procedure, users can click on the Help Command Button located on the top right side of the form. This button provides detailed information about the functions of each command button on the form, explaining what they do and how to select files in different ways.

There is a table named DirectoryList designed to store the selected files in hyperlink format in the table's first column. The second column displays the full path of the files for reference. Clicking on the hyperlink will open the file in its native application, such as MS Word or Excel.

The Call ButtonStatus() statement invokes the ButtonStatus() subroutine, which checks whether the DirectoryList table is empty or not. If the table is empty, all command buttons except the 'Create File Links' and 'Help' buttons are disabled. This subroutine is called from within other subroutines and from the FLst_Object_Init class module. Please refer to the VBA code highlighted in red inside the Class_Init() subroutine above.

If you create a function within a stand-alone class module with public scope, it becomes accessible across other class modules or standard modules within the program. This allows you to call and utilize this function from outside the class module.

We will do some trial runs to learn how to call a Function from another Class Module, from the Standard Module, and from the Form Module after this Subroutines review.

The cmdDelLink Subroutine.

Select a single Record by clicking on the Record Selector Button, to delete it from the Hyperlink List, and click on the Delete Link Command Button. Before deleting the record a message is displayed to reconfirm the action or to Cancel it.

'Delete the Link From the List
Private Sub cmdDelLink()
On Error GoTo cmdDelLink_Click_Err
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim strFile As String
Dim msg As String

'Read the current record Pathname
strFile = cmdfrm.DirectoryList.Form!Path
Set db = CurrentDb
Set rst = db.OpenRecordset("DirectoryList", dbOpenDynaset)
rst.FindFirst "Path = '" & strFile & "'"
If Not rst.NoMatch Then
    msg = UCase("Link: " & strFile & vbCr & "DELETE from above List?")
    
If MsgBox(msg, vbQuestion + vbYesNo, "cmddelLink_Click()") = vbYes Then
    rst.Delete
    rst.Requery
    cmdfrm.DirectoryList.Form.Requery
    MsgBox UCase("File Link: " & strFile & " Deleted.")
End If
Else
    MsgBox UCase("Link: " & strFile & " Not Found!!")
End If

Call ButtonStatus

rst.Close
Set rst = Nothing
Set db = Nothing

cmdDelLink_Click_Exit:
Exit Sub

cmdDelLink_Click_Err:
MsgBox Err & " : " & Err.Description, , "cmdDelLink_Click()"
Resume cmdDelLink_Click_Exit
End Sub

The cmdDelAll() Subroutine.

This Subroutine Deletes all the Records from the DirectoryList Table. All three Command Buttons with Delete actions are disabled and remain disabled till at least one file is added to the Hyperlink List.

Private Sub cmdDelAll()
Dim msg As String
Dim yn As Integer
Dim listcount As Long

On Error GoTo cmdDelAll_Click_Err
listcount = DCount("*", "DirectoryList")
If listcount = 0 Then
    cmdfrm.cmdDelAll.Enabled = False
    Exit Sub
Else
    cmdfrm.cmdDelAll.Enabled = True
End If

msg = "All File Links in the List will be Deleted!"
msg = msg & vbCr & "Are You sure?"
If MsgBox(msg, vbYesNo + vbCritical, "cmdDelAll()") = vbYes Then
    If MsgBox("Deleting All File Links?", vbOKCancel + vbInformation, "cmdDelAll()") = vbOK Then
        DoCmd.SetWarnings False
        DoCmd.OpenQuery "DeleteAll_LinksQ", acViewNormal
        DoCmd.SetWarnings True
        cmdfrm.DirectoryList.Form.Requery
        cmdfrm.cmdDelAll.Enabled = False
    End If
End If

Call ButtonStatus

cmdDelAll_Click_Exit:
Exit Sub

cmdDelAll_Click_Err:
MsgBox Err & " : " & Err.Description, , "cmdDelAll_Click()"
Resume cmdDelAll_Click_Exit
End Sub

The cmdDelFile() Subroutine.

Caution:

Be careful before using this Command Button. This Button Click will delete the File from the Disk and the Link from the list. Use this Command Button only to delete the file from the Disk.

'Caution: Deletes the File from Disk
'1. Delete the File from Disk
'2. Remove selected link from List
Private Sub cmdDelFile()
On Error GoTo cmdDelFile_Click_Err
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim strFile As String
Dim msg As String

'Read selected Record Pathinfo
strFile = cmdfrm.DirectoryList.Form!Path
Set db = CurrentDb
Set rst = db.OpenRecordset("DirectoryList", dbOpenDynaset)
rst.FindFirst "Path = '" & strFile & "'"
If Not rst.NoMatch Then
    msg = UCase("File: " & strFile & vbCr & "DELETE from Disk?")
If MsgBox(msg, vbQuestion + vbYesNo, "cmdDelFile_Click") = vbYes Then
    
   If MsgBox(UCase("Are you sure you want to Delete") & vbCr _
   & UCase(rst!Path & " File from DISK?"), vbCritical + vbYesNo, "cmdDelFile_Click()") = vbNo Then
    GoTo cmdDelFile_Click_Exit
   End If
   'Delete record entry from Table DirectoryList
    rst.Delete
    rst.Requery
    
Call ButtonStatus

    'Delete file from Disk
    If Len(Dir(strFile)) > 0 Then
        Kill strFile
        MsgBox "File: " & strFile & " Deleted."
    Else
        MsgBox "File: " & strFile & vbCr & "Not Found on Disk!"
    End If
  End If
Else
    MsgBox "File: " & strFile & " Not Found!!"
End If

cmdDelFile_Click_Exit:
    rst.Close
    Set rst = Nothing
    Set db = Nothing
Exit Sub

cmdDelFile_Click_Err:
MsgBox Err & " : " & Err.Description, , "cmdDelFile_Click()"
Resume cmdDelFile_Click_Exit
End Sub

The ButtonStatus()

All three Delete Subroutines in the Flst_CmdButton and also from the FLst_Object_Init Class call this Public Subroutine ButtonStatus() to Disable the Command Buttons if the DirectoryList Table is Empty.

Public Sub ButtonStatus()
Dim listcount As Long

On Error GoTo ButtonsStatus_Err:

listcount = DCount("*", "DirectoryList")
cmdfrm.DirectoryList.Form.Requery

If listcount = 0 Then
    cmdfrm.cmdDelLink.Enabled = False
    cmdfrm.cmdDelAll.Enabled = False
    cmdfrm.cmdDelFile.Enabled = False
Else
    cmdfrm.cmdDelLink.Enabled = True
    cmdfrm.cmdDelAll.Enabled = True
    cmdfrm.cmdDelFile.Enabled = True
End If

ButtonsStatus_Exit:
Exit Sub

ButtonsStatus_Err:
MsgBox Err & " : " & Err.Description, , "ButtonsStatus()"
Resume ButtonsStatus_Exit
End Sub

Calling Public Function from Class Module.

Create a Class Module with the name ClsDateTime.

Copy and Paste the following Function Code into the Class Module:

Option Compare Database
Option Explicit

Public Function DateTime() As String
Dim fmt As String

fmt = "dd/mm/yyyy hh:nn:ss"
DateTime = "DateTime: " & Format(Now(), fmt)

End Function

Save the Class Module.
Create a New Form with the name Form1, or any other name you prefer and open it in Design View.
Add a TextBox Control on the Form and make sure the TextBox Name is Text0.
Display the Property Sheet of the Form and select the Other Tab in the Property Sheet.
Set the Has Module Property value to Yes to add a Class Module to the Form.
Display the Code Module of Form1, Copy and Paste the following Code in the Form Module, Save and Close the Form:
```
Private Sub Form_Load()
Dim DT As New ClsDateTime

Me.Text0 = DT.DateTime

End Sub
```
Open Form1 in Normal View. The current Date and Time will appear in the TextBox.

In the Form_Load() Event Procedure creates an Instance of the ClsDateTime Class Module with the object name DT. The next statement while entering DT. the DateTime() Function name will appear and all we have to do is to add the Function. When the Form is open the Date and Time information is displayed in the TextBox.

The same procedure can be repeated between two Class Modules to call the Function in another Class Module, instead of the Form Module.

We use three levels of Class Modules for our Streamlined Structured VBA Coding examples. Let us try this Function in a similar setup i.e. the Form Module, the Intermediary Class Module, and the Class Module with our DateTime() Function.

Make a Copy of Form1 and name it as Form2.
Rename the TextBox Name to Text2.
Display its Class Module, then Copy and Paste the following two Lines of Code, overwriting the existing lines.
```
Option Compare Database

Private test As New Class1
```
Create a Class Module with the Name Class1.

Copy and Pase the Following Code into the Class1 Module:

Option Compare Database

Private D  As New ClsDateTime

Private Sub Class_initialize()
  Forms("Form2").Text2 = D.DateTime
End Sub

Select Save from the File Menu to save all the Files.
Open Form2 in Normal View. The DateTime value should appear in Text2 TextBox on the Form.

Since Class Modules cannot load themselves in Memory we used Form2 Module to create an Instance of Class1 Module into memory. When Class1 Class Module is loaded into memory it creates an Instance of the ClsDateTime Class Module and executes the Class_Initialize() Subroutine. From within this Subroutine Calls the DateTime() Public Function. The result received is saved in the TextBox in Form2.

Hope you understand now how it works.

Try Calling the DateTime() Function from the Standard Module from a Test() Function.

Demo Database Download Link.

DirListing2K1.zip

LEARN MS-ACCESS TIPS AND TRICKS

Monday, October 30, 2023