使用 ADO 在 Excel 工作簿中读取和写入数据时未复制最后一个 Header 单元格？

Posted 2023-03-28

【中文标题】使用 ADO 在 Excel 工作簿中读取和写入数据时未复制最后一个 Header 单元格？

【英文标题】：Last Header cell not copied by using ADO to read and write data in Excel workbooks?

【发布时间】：2022-01-15 04:48:51

【问题描述】：

我使用下面的代码从关闭的工作簿（“Sheet1”）中复制数据，使用 ADO 在 Excel 工作簿中读取和写入数据。

按照我指定的要求成功复制数据除了Last Header cell。

我尝试在ADO连接中更改HDR=NO to HDR=Yes，但同样的问题。

一如既往：非常感谢您的帮助。

Public Sub GetData(SourceFile As Variant, SourceSheet As String, _
                   SourceRange As String, TargetRange As Range, Header As Boolean, UseHeaderRow As Boolean)

    Dim rsCon As Object, rsData As Object
    Dim szConnect As String, szSQL As String
    Dim lCount As Long

    szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 12.0;HDR=NO"";"

    If SourceSheet = "" Then   'Workbook level name
        szSQL = "SELECT * FROM " & SourceRange$ & ";"
    Else
        ' worksheet level name or range
        szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$ & "];"
    End If

On Error GoTo SomethingWrong

    Set rsCon = CreateObject("ADODB.Connection")
    Set rsData = CreateObject("ADODB.Recordset")

    rsCon.Open szConnect
    rsData.Open szSQL, rsCon, 0, 1, 1

    If Not rsData.EOF Then   ' Check to make sure we received data and copy the data

        If Header = False Then
            TargetRange.Cells(1, 1).CopyFromRecordset rsData
          Else
        End If
      Else: MsgBox "No records returned from : " & SourceFile, vbCritical
    End If
    
    rsData.Close  ' Clean up our Recordset object.
    Set rsData = Nothing
    rsCon.Close
    Set rsCon = Nothing
    Exit Sub

SomethingWrong:
    MsgBox "The file name, Sheet name or Range is invalid of : " & SourceFile, _
           vbExclamation, "Error"
    On Error GoTo 0
End Sub

Sub GetData_Example4()    'Select one file with GetOpenFilenamewhere
    Dim SaveDriveDir As String, MyPath As String
    Dim FName As Variant

    SaveDriveDir = CurDir
    MyPath = Application.DefaultFilePath
    ChDrive MyPath
    ChDir MyPath
    FName = Application.GetOpenFilename(filefilter:="Excel Files, *.xl*")

    If FName = False Then
        'do nothing
    Else
        GetData FName, "Sheet1", "A1:D5", Sheets("Sheet1").Range("A1"), False, False
    End If

    ChDrive SaveDriveDir
    ChDir SaveDriveDir
End Sub

【问题讨论】：

你是什么意思，你根本没有得到标题或者只是最后一个？您需要循环 rsData.fields 名称并填充它们。

@Nathan_Sav 只有最后一个没有被复制

填充标题的代码在哪里？

我已经通过分配 HDR=NO @ Nathan_Sav 将 Header 设置为 False

看看这个页面的中心docs.microsoft.com/en-us/previous-versions/office/troubleshoot/…标题设置，设置第1行包含字段名称

【参考方案1】：

该标题可能丢失，因为 ADO 已确定该列是数字，因此标题会自动转换为 null，因为它不是数字。当您使用 HDR=No 时，您告诉 ADO 第 1 行是数据的一部分。

您可以尝试移动它在源数据中的位置，它仍应显示该行为。

您真的不希望 ADO 将您的标题视为数据集的一部分，因此您需要在 SQL 中跳过它们（通过从您的范围中排除标题行） supply) 或在连接中使用 HDR=Yes。

如果使用 HDR=Yes，那么在使用 CopyFromRecordSet 之前，您需要向子程序添加一些代码以读取记录集中的每个字段名称并填充结果表上的标题行。

【讨论】：

你是对的 ADO 已决定该列是数字 我将其更改为文本，然后它可以正常工作。现在的问题如果 Header 包含合并的单元格，结果是空白行，因此我更喜欢设置 HDR=NO。您是否建议接受您的答案并创建一个新问题，或者您可以编辑您的答案？

如果您不想查询标题，则保留您的 HDR=No 并从第二行开始查询（这就是我所说的“在您的 SQL 中跳过它们”的意思——在上面编辑以使更清楚）。包含合并单元格的范围不适合使用 SQL 查询数据。