数组下标越界

rendiule01

D:\图片\合成图片的文件夹有如下图片(图片格式有多种或者1种）
图片.zip (1.36 MB, 下载次数: 8)

2023-5-13 14:30 上传

点击文件名下载附件

410265195121584652-1.jpg
410265195121584652-2.png
652145268554125874-1.jpg
652145268554125874-2.bmp
655625202003060718-1.gif
655625202003060718-2.jepg
求助ACCESS VBA 怎样遍历文件夹，装入数组arr
arr(i,1)                 arr(i,2)     arr(i,3)
410265195121584652-1     jpg           D:\图片\合成图片\410265195121584652-1.jpg  
410265195121584652-2     png           D:\图片\合成图片\410265195121584652-2.png
652145268554125874-1     jpg           D:\图片\合成图片\652145268554125874-1.jpg
652145268554125874-2     bmp           D:\图片\合成图片\652145268554125874-2.bmp
655625202003060718-1     gif           D:\图片\合成图片\655625202003060718-1.gif
....................    .....          .......................................

然后把数组arr一次性写入TMP_Image表
图片名称     
        图片格式         图片路径
410265195121584652-1     jpg           D:\图片\合成图片\410265195121584652-1.jpg  
410265195121584652-2     png           D:\图片\合成图片\410265195121584652-2.png

SUB TEST()
' 定义数组变量
Dim arr() As Variant
ReDim arr(0 To 2, 0 To 0)

' 指定图片文件夹路径
Dim folderPath As String
folderPath = "D:\图片\合成图片"

' 使用 FileSystemObject 进行文件夹遍历
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim fldr As Object
Set fldr = fso.GetFolder(folderPath)

Dim i As Long
i = 0

For Each file In fldr.Files
    ' 判断是否为图片文件
    If InStr(1, file.Type, "image", vbTextCompare) > 0 Then
        ' 解析文件名及文件类型
        Dim fileName As String
        fileName = Left(file.Name, InStrRev(file.Name, ".") - 1)
        Dim fileType As String
        fileType = Right(file.Name, Len(file.Name) - InStrRev(file.Name, "."))

        ' 将信息插入到数组中
        arr(0, i) = fileName
        arr(1, i) = fileType
        arr(2, i) = file.Path

        i = i + 1
        ' 扩展数组并保留之前已经读取进来的数据
       ReDim Preserve arr(0 To 2, 0 To i)
    End If
Next

' 删除多余的空元素
ReDim Preserve arr(0 To 2, 0 To i - 1)

' 将数组中的数据一次性写入tptable表
Dim db As DAO.Database
Dim rs As DAO.Recordset

Set db = CurrentDb
Set rs = db.OpenRecordset("TMP_Image", dbOpenTable, dbAppendOnly)

For i = LBound(arr, 2) To UBound(arr, 2)
    rs.AddNew
    rs("tp_no").Value = arr(0, i)
    rs("tp_type").Value = arr(1, i)
    rs("spath").Value = arr(2, i)
    rs.Update
Next i

rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
END SUB


报错下标越界，调试停留在ReDim Preserve arr(i, 2)
Sub loadFilesToArray()
    Dim folderPath As String
    Dim fileExt As String
    Dim fso As Object
    Dim myDir As Object
    Dim myFile As Object
    Dim arr() As Variant
    Dim i As Long


    ' 设置文件夹路径
    folderPath = "D:\图片\合成图片"
    Set fso = CreateObject("Scripting.FileSystemObject")


    ' 获取文件夹对象
    Set myDir = fso.GetFolder(folderPath)


    ' 初始化数组大小
    ReDim arr(0 To -1, 0 To 2)


    ' 遍历所有文件，将符合条件的文件信息装入数组
    For Each myFile In myDir.Files
        ' 获取文件类型
        fileExt = Right(myFile.Name, Len(myFile.Name) - InStrRev(myFile.Name, "."))
        Select Case LCase(fileExt)
            Case "jpg", "jpeg", "bmp", "png", "gif"
                ' 扩展数组并保留之前已经读取进来的数据
                ReDim Preserve arr(i, 2)
                arr(i, 0) = myFile.Name
                arr(i, 1) = fileExt
                arr(i, 2) = myFile.Path
                i = i + 1
        End Select
    Next myFile
   
    ' 将数组一次性写入表中
    With CurrentDb.OpenRecordset("TP_TABLE")
        For i = 0 To UBound(arr)
            .AddNew
            !TP_NO = arr(i, 0)
            !TP_TYPE = arr(i, 1)
            !SPATH = arr(i, 2)
            .Update
        Next i
    End With


    ' 释放对象
    Set fso = Nothing
    Set myFile = Nothing
    Set myDir = Nothing
   
    MsgBox "文件已经成功载入数组和写入表。"
End Sub

taller

redim只能修改最后一维的上/下界

rendiule01

不就是很明白，那怎样修改