VBA宏内调用转CSV功能时出现记录缺失问题求助

核心问题 #

你遇到的CSV缺失记录问题，根源在于ConvertToCsv宏中**lRow变量未初始化赋值**：

• 单独运行时，可能因之前手动操作的环境残留，lRow巧合获得了正确的最后行号；
• 但在GetData内部自动调用时，未赋值的lRow会被VBA视为空值，导致复制的单元格范围仅包含极少行甚至无有效数据，最终生成的CSV缺失记录。

此外代码还存在拼写错误（WirteRecordsToSheets应为WriteRecordsToSheets）、依赖ActiveWorkbook/Select导致上下文切换风险等问题。

修复后的完整代码 #

1. GetData宏与写入函数 #

Option Explicit

Sub getData()
    Dim comm As ADODB.Command
    Dim rec As ADODB.Recordset
    Dim row As Long, col As Integer
    
    ' 此处补充comm的初始化、连接数据库等代码
    
    comm.CommandText = "SELECT x, y, z FROM A"
    rec.Open comm
    
    If rec.EOF Then
        MsgBox "没有记录"
        rec.Close
        Set rec = Nothing
        Set comm = Nothing
        Exit Sub
    End If
    
    row = 1
    col = 1
    Do While Not rec.EOF
        WriteRecordsToSheets rec, col, row ' 修复函数名拼写错误
        col = 1
        row = row + 1
        rec.MoveNext
    Loop
    
    ' 关闭资源
    rec.Close
    Set rec = Nothing
    Set comm = Nothing
    
    ThisWorkbook.Save
    ConvertToCsv row - 1 ' 将最后一行行号传给转CSV宏，避免重复计算
End Sub

Sub WriteRecordsToSheets(rec As ADODB.Recordset, ByVal xlCol As Integer, ByVal xlRow As Integer)
    ' 避免Select，直接引用工作表
    With Worksheets("1")
        .Cells(xlRow, xlCol).NumberFormat = "@"
        .Cells(xlRow, xlCol).Value = Trim(rec("x"))
        
        xlCol = xlCol + 1
        .Cells(xlRow, xlCol).NumberFormat = "@"
        .Cells(xlRow, xlCol).Value = Trim(rec("y"))
        
        xlCol = xlCol + 1
        .Cells(xlRow, xlCol).NumberFormat = "@"
        .Cells(xlRow, xlCol).Value = Trim(rec("z"))
    End With
End Sub

2. ConvertToCsv宏 #

Option Explicit

Sub ConvertToCsv(Optional ByVal lRow As Long = 0)
    Dim fRow As Long, fCol As Integer, lCol As Integer
    Dim filePath As String, fileName As String
    Dim cpFromWB As Workbook, cpToWB As Workbook
    Dim cpFromRng As Range, cpToRng As Range
    
    fRow = 1
    fCol = 1
    lCol = 20
    filePath = "C:\aaa\bbb\"
    fileName = "file.csv"
    
    MakeDirectory filePath
    
    With Worksheets("1")
        ' 如果未传入行号，自动计算最后一行数据行
        If lRow = 0 Then
            lRow = .Cells(.Rows.Count, fCol).End(xlUp).Row
        End If
        ' 修剪数据空格
        .Range(.Cells(fRow, fCol), .Cells(lRow, lCol)).Value = Application.Trim(.Range(.Cells(fRow, fCol), .Cells(lRow, lCol)))
        ' 明确设置复制范围
        Set cpFromRng = .Range(.Cells(fRow, fCol), .Cells(lRow, lCol))
    End With
    
    Set cpFromWB = ThisWorkbook
    Set cpToWB = Workbooks.Add
    Set cpToRng = cpToWB.ActiveSheet.Range("A1")
    
    cpFromRng.Copy Destination:=cpToRng
    
    Application.DisplayAlerts = False
    ' 直接引用新工作簿，避免ActiveWorkbook上下文切换问题
    cpToWB.SaveAs fileName:=filePath & fileName, FileFormat:=xlCSV, CreateBackup:=False
    cpToWB.Close SaveChanges:=True
    Application.DisplayAlerts = True
    
    MsgBox "CSV文件 '" & fileName & "' 已成功保存至路径: " & filePath
End Sub

关键优化点 #

1. 初始化lRow：通过自动计算或从GetData传递参数，确保复制范围包含所有数据行；
2. 避免Select/ActiveWorkbook：直接引用工作表和工作簿，防止因窗口切换导致的上下文错误；
3. 开启Option Explicit：强制变量声明，避免拼写错误和未初始化变量问题；
4. 关闭数据库资源：在GetData中主动关闭Recordset和Command，避免内存泄漏。

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