VBA 代码报错“下标越界”：解决方法及优化代码

在使用 VBA 编写代码时，经常会遇到“下标越界”的错误。这种错误通常是由于数组在使用前没有进行初始化，导致访问了不存在的元素。

以下示例代码演示了“下标越界”错误的发生和解决方法：

Option Explicit

Sub FindAndCopyPictures()
    On Error GoTo ErrorHandler '添加错误处理
    
    Dim fso As New FileSystemObject
    Dim Folder As Scripting.Folder
    Dim subFolder As Scripting.Folder
    Dim File As Scripting.File
    
    Dim picPaths() As String '保存匹配成功的图片文件路径
    ReDim picPaths(0) '初始化数组
    Dim picIndex As Integer '匹配成功的图片文件数量
    
    Dim dict As Object '字典对象，用于保存产品名称列表
    Dim i As Integer
    Dim Key As Object
    
    '读取 Excel 中的产品名称列表，建立一个字典对象
    Set dict = CreateObject("Scripting.Dictionary")
    With ThisWorkbook.Sheets("Sheet1")
        For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            dict(.Cells(i, 1).Value) = True
        Next i
    End With
    
    '遍历指定文件夹及其子文件夹下的所有图片文件
    Set Folder = fso.GetFolder("C:\Users\wjm12\工作文档\#KUKA\材料+产品图片 - 重命名\外贸浏览图缩略图 - 重命名\0常用产品图片") '指定要查找的文件夹路径
    picIndex = 0 '初始化匹配成功的图片文件数量
    For Each subFolder In Folder.SubFolders
        For Each File In subFolder.Files
            '判断当前文件是否为图片文件
            If InStr(1, "|.jpg|.jpeg|.bmp|.gif|.png|", "|" & fso.GetExtensionName(File.Path) & "|", vbTextCompare) > 0 Then
                '对每个图片文件进行匹配
                For Each Key In dict.keys
                    If InStr(1, File.Name, Key, vbTextCompare) > 0 Then
                        '判断当前文件是否已经存在于 picPaths 数组中
                        If Not IsInArray(File.Path, picPaths) Then
                            '将匹配成功的图片文件路径添加到数组中
                            ReDim Preserve picPaths(picIndex) '扩展数组
                            picPaths(picIndex) = File.Path
                            picIndex = picIndex + 1 '匹配成功的图片文件数量加 1
                        End If
                        Exit For '跳出循环，避免重复添加同一张图片
                    End If
                Next Key
            End If
        Next File
    Next subFolder
    
    '创建一个新的文件夹，将匹配成功的图片文件复制到该文件夹中
    Dim newFolder As Object
    Set newFolder = fso.CreateFolder("C:\Users\wjm12\Desktop\NewPictures") '指定新建的文件夹路径
    For i = 0 To UBound(picPaths)
        fso.CopyFile picPaths(i), newFolder.Path & "\" & fso.GetFileName(picPaths(i)), True '添加重复文件处理
    Next i
    
    '释放对象
    Set fso = Nothing
    Set dict = Nothing
    
    Exit Sub

ErrorHandler:
    MsgBox Err.Description, vbExclamation, "Error " & Err.Number '显示错误信息
    Set fso = Nothing
    Set dict = Nothing
End Sub

Function IsInArray(valToBeFound As Variant, arr As Variant) As Boolean
    '判断 valToBeFound 是否在 arr 数组中
    Dim element As Variant
    On Error GoTo NotFound
    For Each element In arr
        If element = valToBeFound Then
            IsInArray = True
            Exit Function
        End If
    Next element
NotFound:
    IsInArray = False
End Function

代码优化说明：

添加数组初始化语句: 在使用 picPaths 数组之前，添加 ReDim picPaths(0) 初始化语句，确保数组被正确创建，避免了“下标越界”错误的发生。
错误处理: 代码中使用了 On Error GoTo ErrorHandler 语句，并在 ErrorHandler 中显示错误信息，方便开发者定位和解决错误。
代码注释: 代码中添加了详细的注释，解释了每一段代码的逻辑和功能，提高了代码的可读性和可维护性。

总结：

“下标越界”错误是 VBA 代码中常见的错误，可以通过添加数组初始化语句、使用错误处理机制、添加详细的注释等方式来避免和解决。合理使用代码优化技巧，可以有效提高代码质量，降低维护成本。