Excel

Show a List of Files to Open

Ease of Use

Intermediate

Version tested with

2002 / 2000 

Submitted by:

Jacob Hilderbrand

Description:

This macro will show a list of files in a UserForm, where the filename meet criteria. 

Discussion:

You want to ask a user for a file to open, but you want to filter the list of files so they open an appropriate one. Maybe they have 100s of Excel files in a folder and you store special files there too, so you want a filtered list of only those files that meet specific name criteria. This macro demonstrates how to do that. 

Code:

instructions for use

			

'Place this code in a Module Option Compare Text Option Explicit Public Path As String Private Const BIF_RETURNONLYFSDIRS As Long = &H1 Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2 Private Const BIF_RETURNFSANCESTORS As Long = &H8 Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000 Private Const BIF_BROWSEFORPRINTER As Long = &H2000 Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000 Private Const MAX_PATH As Long = 260 Type BrowseInfo hOwner As Long pidlRoot As Long pszDisplayName As String lpszINSTRUCTIONS As String ulFlags As Long lpfn As Long lParam As Long iImage As Long End Type Type SHFILEOPSTRUCT hwnd As Long wFunc As Long pFrom As String pTo As String fFlags As Integer fAnyOperationsAborted As Boolean hNameMappings As Long lpszProgressTitle As String End Type Declare Function SHGetPathFromIDListA Lib "shell32.dll" ( _ ByVal pidl As Long, _ ByVal pszBuffer As String) As Long Declare Function SHBrowseForFolderA Lib "shell32.dll" ( _ lpBrowseInfo As BrowseInfo) As Long Function BrowseFolder(Optional Caption As String = "") As String Dim BrowseInfo As BrowseInfo Dim FolderName As String Dim ID As Long Dim Res As Long With BrowseInfo .hOwner = 0 .pidlRoot = 0 .pszDisplayName = String$(MAX_PATH, vbNullChar) .lpszINSTRUCTIONS = Caption .ulFlags = BIF_RETURNONLYFSDIRS .lpfn = 0 End With FolderName = String$(MAX_PATH, vbNullChar) ID = SHBrowseForFolderA(BrowseInfo) If ID Then Res = SHGetPathFromIDListA(ID, FolderName) If Res Then BrowseFolder = Left$(FolderName, InStr(FolderName, _ vbNullChar) - 1) End If End If End Function Sub ShowFiles() Dim FileName As String Load UserForm1 With UserForm1 Path = BrowseFolder FileName = Dir(Path & "\*.xls", vbNormal) Do Until FileName = "" If Left(FileName, 3) = "MRR" Then .ListBox1.AddItem (FileName) End If FileName = Dir() Loop .Show End With End Sub 'Place this code in a UserForm 'UserForm must have two command buttons (CommandButton1 & 2) 'UserForm must have one listbox (ListBox1) Option Explicit Private Sub CommandButton1_Click() If ListBox1.Text <> "" Then Workbooks.Open FileName:=Path & "\" & ListBox1.Text End If Unload Me End Sub Private Sub CommandButton2_Click() Unload Me End Sub

How to use:

  1. Open Excel.
  2. Alt + F11 to open the VBE.
  3. Insert | Module
  4. Paste the code from above that is designated for the module.
  5. Change this line (If Left(FileName, 3) = "MRR" Then) to what you want to check the file name for.
  6. Insert | UserForm
  7. Add two command buttons and one listbox from the Control Toolbox.
  8. Double click the UserForm and paste the code from above designated for the UserForm in the Code Window that opens up.
  9. Close the VBE (Alt + Q or press the X in the top-right corner)
 

Test the code:

  1. Tools | Macro | Macros...
  2. Select ShowFiles and press Run.
 

Sample File:

ShowFiles.zip 13.76KB 

Approved by mdmackillop


This entry has been viewed 508 times.

Please read our Legal Information and Privacy Policy
Copyright @2004 - 2020 VBA Express