在VBA中定义文字2D字符串数组

时间:2018-01-17 13:26:23

标签: arrays vba ms-access access-vba

我正在尝试构建一个实用程序函数,通过标准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

但是,在向函数提供filetype过滤器参数时,我发现自己必须做这样的事情:

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"))

有没有更好的方法来定义我缺少的文字2D字符串数组?

非常感谢您提出的意见和建议。反馈

3 个答案:

答案 0 :(得分:1)

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

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

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

答案 1 :(得分:0)

您的上一个方法可行:

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

您的错误必须由其他原因引起。

答案 2 :(得分:0)

使用另一个实用程序函数来制作数组,然后就可以:

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