在 VBA 中定义文字二维字符串数组

Question

我正在尝试构建一个实用函数，以通过标准 Windows 文件对话框提示用户输入任意文件。

我想将文件类型过滤器列表作为二维字符串数组传递，其中每个子数组的第一个元素是文件类型描述，第二个元素是文件类型过滤器。

下面是我的功能：

'' 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

这可行，但是，当向函数提供文件类型过滤器参数时，我发现自己必须做这样的事情：

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

我也尝试了以下方法，但收到“下标超出范围”：

Dim arr() As Variant
arr = Array(Array("Excel Files", "*.xls;*.xlsx"), Array("Text Files", "*.txt"))

有没有更好的方法来定义我缺少的文字二维字符串数组？

非常感谢您的建议和反馈。

Answer 1

因为您评论说您可以编辑 getFile 函数，所以您应该考虑这种方法。使用 Array 可能是一个简单直接的想法，但如果您的应用程序足够复杂，那么您的 Array 初始化可能会变得笨拙。

下面的方法只是对类的介绍，也许是对设计模式的介绍。看看吧。

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

还有一个 FileExtensions 类

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

Answer 2

你的最后一个方法会起作用：

Dim arr() As Variant
arr = Array(Array("Excel Files", "*.xls;*.xlsx"), Array("Text Files", "*.txt"))

您的错误一定是由其他原因引起的。

Answer 3

使用另一个实用函数来制作数组然后你可以：

GetFile , , StrsTo2d("Excel Files", "*.xls;*.xlsx")
GetFile , , StrsTo2d("Excel Files", "*.xls;*.xlsx", "Text Files", "*.txt")
GetFile , , StrsTo2d("Excel Files", "*.xls;*.xlsx", "Text Files", "*.txt", "FooFile", "*.foo")

---

Function StrsTo2d(ParamArray args() As Variant) As String()
    Dim     i As Long
    Dim num As Long: num = (UBound(args) - 1) / 2
    ReDim   out(num, 1) As String

    For i = 0 To num
        out(i, 0) = args(i * 2)
        out(i, 1) = args(i * 2 + 1)
    Next

    StrsTo2d = out
End Function