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

Question

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

数据按照我指定的要求复制成功except 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

Answer 1

可能缺少 header，因为 ADO 已确定该列是数字，因此 header 得到 auto-converted 到 null，因为它不是数字。当您使用 HDR=No.

时，您告诉 ADO row1 是数据的一部分

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

您确实不希望 ADO 将您的 header 视为数据集的一部分，因此您需要在 [= =28=]（通过从您提供的范围中排除 header 行）或在连接中使用 HDR=Yes。

如果使用 HDR=Yes，那么您需要向您的 sub 添加一些代码以读取记录集中的每个字段名称并在结果 sheet 上填充 header 行，然后再使用 CopyFromRecordSet.

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

Last Header cell not copied by using ADO to read and write data in Excel workbooks?

sql

excel

vba

ado