从SQL Server取数据到Excel VBA ListView遇类型不匹配问题求助

问题 #

从数据库获取数据并在UserForm的ListView中展示时，触发「Type Mismatch（类型不匹配）」错误，排查后确认是数据中的空/Null值导致。添加If Not IsNull(Records(j, i)) Then li.ListSubItems.Add , , Records(j, i)判断后错误消失，但出现列错位：当第一列为空、第二列有值时，第二列的值会被填充到第一列的位置。

原代码如下：

Private Sub ListView_Data()
    On Error GoTo ERR_Handler
    Dim sql As String
    Dim con As ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim Records As Variant
    Dim i As Long, j As Long
    Dim RecCount As Long
    
    
    Set con = New ADODB.Connection
    
    con.Open "Provider=SQLOLEDB;Data Source=10.206.88.119\BIWFO;" & _
                          "Initial Catalog=TESTDB;" & _
                          "Uid=user; Pwd=pass;"
                          
    sql = "select * from [TESTDB].[dbo].[tbl_MN_Omega_Raw]"
    
    rst.Open sql, con, adOpenKeyset, adLockOptimistic
    '~~> Get the records in an array
    Records = rst.GetRows
    '~~> Get the records count
    RecCount = rst.RecordCount
    
    '~~> Populate the headers
    For i = 0 To rst.Fields.count - 1
        ListView1.ColumnHeaders.Add , , rst.Fields(i).Name, 200
    Next i
    
    rst.Close
    con.Close

    With ListView1
        .View = lvwReport
        .CheckBoxes = False
        .FullRowSelect = True
        .Gridlines = True
        .LabelWrap = True
        .LabelEdit = lvwManual
           
        Dim li As ListItem
        
        '~~> Populate the records
        For i = 0 To RecCount - 1
            Set li = .ListItems.Add(, , Records(0, i))
            For j = 1 To UBound(Records)
            
            
                If Not IsNull(Records(j, i)) Then li.ListSubItems.Add , , Records(j, i)
                
                'End If
            Next j
        Next i
    End With
    
ERR_Handler:

    Select Case Err.Number
    
        Case 0
        Case Else
        
            MsgBox Err.Description, vbExclamation + vbOKOnly, Err.Number
            
    End Select
End Sub

原因 #

ListView的ListSubItems.Add方法会按调用顺序依次填充子项列。原代码中仅在非Null时添加子项，空值对应的列会被跳过，后续列的子项会自动补位到前一个空列的位置，导致列错位。

解决方法 #

方法1：保留数组方式，为所有列占位 #

无论字段是否为Null，都为对应列添加子项，空值时用空字符串填充，确保每个列的位置对应正确。修改填充数据的循环部分：

'~~> Populate the records
For i = 0 To RecCount - 1
    '处理第一列（ListItems的Text），Null转空字符串
    Dim firstColVal As String
    firstColVal = IIf(IsNull(Records(0, i)), "", Records(0, i))
    Set li = .ListItems.Add(, , firstColVal)
    
    For j = 1 To UBound(Records)
        '为每个列添加子项，Null则填充空字符串
        Dim subItemVal As String
        subItemVal = IIf(IsNull(Records(j, i)), "", Records(j, i))
        li.ListSubItems.Add , , subItemVal
    Next j
Next i

方法2：直接遍历Recordset填充（更直观） #

放弃GetRows转数组的方式，直接遍历Recordset的每条记录和字段，避免数组行列索引混淆，同时确保每个列都被填充：

修改后的完整代码：

Private Sub ListView_Data()
    On Error GoTo ERR_Handler
    Dim sql As String
    Dim con As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim i As Long
    Dim li As ListItem
    
    Set con = New ADODB.Connection
    Set rst = New ADODB.Recordset
    
    con.Open "Provider=SQLOLEDB;Data Source=10.206.88.119\BIWFO;" & _
                          "Initial Catalog=TESTDB;" & _
                          "Uid=user; Pwd=pass;"
                          
    sql = "select * from [TESTDB].[dbo].[tbl_MN_Omega_Raw]"
    
    rst.Open sql, con, adOpenKeyset, adLockOptimistic
    
    '清空现有内容
    ListView1.ColumnHeaders.Clear
    ListView1.ListItems.Clear
    
    '填充表头
    For i = 0 To rst.Fields.Count - 1
        ListView1.ColumnHeaders.Add , , rst.Fields(i).Name, 200
    Next i
    
    With ListView1
        .View = lvwReport
        .CheckBoxes = False
        .FullRowSelect = True
        .Gridlines = True
        .LabelWrap = True
        .LabelEdit = lvwManual
           
        '遍历记录填充数据
        Do While Not rst.EOF
            '处理第一列
            Dim firstCol As String
            firstCol = IIf(IsNull(rst.Fields(0).Value), "", rst.Fields(0).Value)
            Set li = .ListItems.Add(, , firstCol)
            
            '处理后续子项列
            For i = 1 To rst.Fields.Count - 1
                Dim subVal As String
                subVal = IIf(IsNull(rst.Fields(i).Value), "", rst.Fields(i).Value)
                li.ListSubItems.Add , , subVal
            Next i
            
            rst.MoveNext
        Loop
    End With
    
    '清理资源
    rst.Close
    con.Close
    Set rst = Nothing
    Set con = Nothing
    
ERR_Handler:
    If Err.Number <> 0 Then
        MsgBox Err.Description, vbExclamation + vbOKOnly, Err.Number
        '出错时确保资源释放
        If Not rst Is Nothing Then
            If rst.State = adStateOpen Then rst.Close
            Set rst = Nothing
        End If
        If Not con Is Nothing Then
            If con.State = adStateOpen Then con.Close
            Set con = Nothing
        End If
    End If
End Sub

说明 #

• 方法1适用于想保留原数组逻辑的场景，核心是不跳过任何列，用空字符串占位空值。
• 方法2代码可读性更高，避免了GetRows数组的行列顺序陷阱（原数组是[字段索引, 记录索引]的结构，容易搞混），同时增加了资源释放的容错处理。

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