Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Defining a Literal 2D String Array in VBA

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.

like image 741
Lee Mac Avatar asked Dec 19 '25 04:12

Lee Mac


1 Answers

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
like image 177
Krish Avatar answered Dec 21 '25 18:12

Krish



Donate For Us

If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!