I'm trying to construct a utility function to prompt the user for an arbitrary file via the standard Windows file dialog.
I would like to pass the list of filetype filters as a two dimensional array of strings, where the first element of each subarray is the filetype description and the second element is the filetype filter.
Below is my function:
'' GetFile - Lee Mac
''
'' Prompts the user to select a file using a standard Windows file dialog
''
'' msg - [str] Dialog title
'' ini - [str] Initial filename/filepath
'' flt - [arr] Array of filetype filters
''
Function GetFile(Optional strMsg As String = "Select File", Optional strIni As String = vbNullString, Optional arrFlt) As String
Dim dia As FileDialog
Set dia = Application.FileDialog(msoFileDialogFilePicker)
With dia
.InitialFileName = strIni
.AllowMultiSelect = False
.Title = strMsg
.Filters.Clear
If IsMissing(arrFlt) Then
.Filters.Add "All Files", "*.*"
Else
Dim i As Integer
For i = 0 To UBound(arrFlt, 1)
.Filters.Add arrFlt(i, 0), arrFlt(i, 1)
Next i
End If
If .show Then
GetFile = .selecteditems.Item(1)
End If
End With
End Function
This works, however, when supplying the filetype filter argument to the function, I find myself having to do something like this:
Function test()
Dim arr(1, 1) As String
arr(0, 0) = "Excel Files"
arr(0, 1) = "*.xls;*.xlsx"
arr(1, 0) = "Text Files"
arr(1, 1) = "*.txt"
GetFile , , arr
End Function
I've also tried the following but receive 'Subscript out of range':
Dim arr() As Variant
arr = Array(Array("Excel Files", "*.xls;*.xlsx"), Array("Text Files", "*.txt"))
Is there a better way to define a literal 2D string array that I'm missing?
Many thanks in advance for your advice & feedback.
Because you commented that you could edit the getFile function, you should consider this approach. Using an Array might be a simple and straightforward idea but if your applications is complex enough, there is a chance your Array initialisations could become clumsy.
Below approach is just an introduction to classes and maybe to design pattern. Have a look.
Public Function test()
Dim fe As New FileExtensions 'initialise your file extension class
'Add filters
fe.AddFilter "All Files", "*.*" 'add here or in class defaults
fe.AddFilter "Excel Files", "*.xls; *.xlsx"
fe.AddFilter "Text Files", "*.txt"
GetFile , , fe
End Function
Function GetFile(Optional strMsg As String = "Select File", Optional strIni As String = vbNullString, Optional arrFlt) As String
Dim dia As Object
Set dia = Application.FileDialog(3)
With dia
.InitialFileName = strIni
.AllowMultiSelect = False
.Title = strMsg
.filters.Clear
'Simply retrieve the filters from extension class
If Not IsMissing(arrFlt) Then
Dim i As Long
For i = 0 To arrFlt.getCount - 1
.filters.ADD arrFlt.getDescription(i), arrFlt.getFilter(i)
Next i
End If
If .Show Then
GetFile = .selecteditems.item(1)
End If
End With
End Function
and a FileExtensions class
Option Compare Database
Option Explicit
Private Type FileExtension
tDescription As String
tFilter As String
End Type
Private Holder() As FileExtension
Public Sub class_initialize()
ReDim Holder(0) ' or if you want to add default filters
End Sub
Public Sub AddFilter(Description As String, Filter As String)
ReDim Preserve Holder(UBound(Holder) + 1)
Holder(UBound(Holder) - 1).tDescription = Description
Holder(UBound(Holder) - 1).tFilter = Filter
End Sub
Public Function getCount() As Long
getCount = UBound(Holder)
End Function
Public Function getDescription(index As Long) As String
getDescription = Holder(index).tDescription
End Function
Public Function getFilter(index As Long) As String
getFilter = Holder(index).tFilter
End Function
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With