查询.mdb数据库后在Outlook显示数组时遇“subscript out of range”错误求助

咱们先拆解一下你遇到的问题，再一步步修正代码：

错误原因分析 #

1. 数组维度使用错误：GetRows()返回的是二维数组，结构是(字段索引, 记录索引)。你只查询了userName一个字段，所以数组第一维只有索引0，第二维才是每条用户记录的索引。你直接用userArray(i)访问，相当于越界访问第一维的非存在索引，这就是“Subscript Out of Range”的根源。
2. 冗余的记录集循环：GetRows()默认会一次性拉取记录集里的所有剩余记录，你在Do While循环里重复赋值数组，不仅会覆盖之前的数据，还会导致记录集指针异常，完全没必要这么做。
3. Outlook实例创建逻辑混乱：你先尝试获取已打开的Outlook实例，失败后启动Outlook，但之后又直接创建新实例，这会导致不必要的资源占用，逻辑上也不严谨。

修正后的完整代码 #

Public Sub sendNotifForm4()
    Dim userArray() As Variant
    Dim i As Integer
    Dim objOutlook As Object
    Dim objOutlookMsg As Outlook.MailItem
    Dim objOutlookRecip As Outlook.Recipient
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim mailBody As String ' 用字符串变量拼接邮件内容，更高效
    
    ' 打开数据库并获取记录集
    Set db = OpenDatabase("C:/Users/FTK1187/Desktop/eArchiveMaster.mdb", False, False, ";")
    Set rs = db.OpenRecordset(Name:="SELECT userName FROM userTable WHERE flag = 'NO'")
    
    ' 一次性获取所有记录到二维数组，不需要循环
    If Not rs.EOF Then
        userArray = rs.GetRows
    End If
    
    ' 关闭记录集和数据库
    rs.Close
    Set rs = Nothing
    db.Close
    Set db = Nothing
    
    ' 获取或创建Outlook实例
    On Error Resume Next
    Set objOutlook = GetObject(, "Outlook.Application")
    If Err.Number <> 0 Then
        Set objOutlook = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0 ' 恢复错误捕获
    
    ' 创建邮件
    Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
    objOutlookMsg.Subject = "E - Archiving User Account Approvements"
    
    ' 拼接邮件正文（先存在字符串变量里，减少对Body属性的重复操作）
    mailBody = "Dear Admin," & vbNewLine & vbNewLine & _
               "Please approve this user accounts" & vbNewLine & vbNewLine
    
    ' 遍历二维数组：第二维是记录索引，第一维0对应userName字段
    If Not IsEmpty(userArray) Then
        For i = LBound(userArray, 2) To UBound(userArray, 2)
            mailBody = mailBody & "User Name: " & userArray(0, i) & vbNewLine & _
                       "Approval : NO" & vbNewLine & vbNewLine
        Next i
    End If
    
    mailBody = mailBody & "Best Regards"
    objOutlookMsg.Body = mailBody
    
    ' 添加收件人并发送
    Set objOutlookRecip = objOutlookMsg.Recipients.Add("Mustafa.Demir@pw.utc.com")
    objOutlookMsg.Send
    
    ' 释放对象
    Set objOutlookMsg = Nothing
    Set objOutlook = Nothing
End Sub

关键修改点说明 #

• 数组遍历方式：改用userArray(0, i)访问，0是userName字段的索引，i是每条记录的索引；遍历范围用LBound(userArray, 2)到UBound(userArray, 2)定位第二维的记录范围。
• 一次性获取记录：去掉了多余的Do While循环，直接用If Not rs.EOF判断后调用GetRows，避免数组被重复覆盖。
• 邮件正文拼接优化：先用字符串变量mailBody拼接所有内容，最后一次性赋值给objOutlookMsg.Body，比多次修改Body属性更高效。
• Outlook实例优化：修复了实例获取逻辑，只有当GetObject失败时才创建新实例，避免重复启动或创建实例。

如果之后想改用HTMLBody来美化邮件格式，只需要把mailBody的内容改成HTML格式（比如用<br>代替vbNewLine，添加标签等），然后赋值给objOutlookMsg.HTMLBody即可，比如：

mailBody = "<p>Dear Admin,</p>" & _
           "<p>Please approve this user accounts</p>" & _
           "<ul>"
If Not IsEmpty(userArray) Then
    For i = LBound(userArray, 2) To UBound(userArray, 2)
        mailBody = mailBody & "<li>User Name: " & userArray(0, i) & "<br>Approval : NO</li>"
    Next i
End If
mailBody = mailBody & "</ul><p>Best Regards</p>"
objOutlookMsg.HTMLBody = mailBody

内容的提问来源于stack exchange，提问作者Mustafa Berkan Demir