VBA将数组内容写入邮件正文时遇下标越界错误求助

错误原因 #

1. 数组下标不匹配：sq数组从下标0开始存储数据，但原代码从y=2开始读取，当数组元素数量不足时（比如仅2个元素，下标为0和1），访问sq(2)会直接触发「下标越界」。
2. 变量未重置：sq、x、y在循环外部定义，每次处理新收件人时未清空重置，导致旧数据累积，下标逻辑彻底混乱。

修复后的代码 #

Dim lRow As Long
Dim sBody As String
Dim location_sheet As String
Dim c As Range ' 补充定义循环变量

lRow = Worksheets("Addresses").Cells(Rows.Count, 4).End(xlUp).Row

For Each c In Worksheets("Addresses").Range("D2:D" & lRow).Cells
    Dim sq() As Variant, ar As Variant
    Dim x As Long, j As Long, jj As Long, y As Long ' 变量移至循环内，每次自动重置
    
    x = 0
    y = 0 ' 匹配数组起始下标
    location_sheet = c.Value
    ar = Sheets(location_sheet).UsedRange
    
    ' 遍历工作表非空数据，存入sq数组
    For j = 1 To UBound(ar)
         For jj = 1 To UBound(ar, 2)
           If ar(j, jj) <> "" Then
               ReDim Preserve sq(x)
               sq(x) = ar(j, jj)
               x = x + 1
             End If
         Next
     Next
    
    ' 构建邮件正文
    sBody = "Hi,"
    Do While y < x ' x是元素总数，数组下标最大为x-1
          sBody = sBody & vbNewLine & sq(y)
          y = y + 1
        Loop
    
    ' 生成并显示邮件
    With CreateObject("outlook.application").createitem(0)
       .To = c.Offset(0, -1).Value
       .Subject = c.Offset(0, -3).Value & " " & c.Offset(0, -2).Value & "-" & c.Value
       .body = sBody
       '.Attachments.Add
       .display '.send
     End With
     
Next

关键修改点 #

• 将sq()、x、y等变量移到For Each c循环内部，每次处理新收件人时自动重置，避免旧数据干扰。
• 把y初始值设为0，匹配sq数组的起始下标，循环条件改为y < x（x记录元素总数，数组下标范围是0到x-1）。
• 补充定义循环变量c，避免隐式类型转换问题。
• 明确声明sBody为字符串类型，提升代码可读性。

内容的提问来源于stack exchange，提问作者k1dr0ck