I use below code to copy data from closed workbook ("Sheet1") using ADO to read and write data in Excel workbooks .

the data copied successfully as my specified requirements except Last Header cell.

I tried to change HDR=NO to HDR=Yes in ADO connection , But the same problem.

As always: great thanks for your help.

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

CodePudding user response：

That header is likely missing because ADO has decided that column is numeric and so the header gets auto-converted to null because it's not numeric. You're telling ADO that row1 is part of the data when you use HDR=No.

You can try moving it's position in the source data and it should still show that behavior.

You really don't want ADO to treat your headers like they're part of your dataset, so you need to either skip them in your SQL (by excluding the header row from the range you supply) or use HDR=Yes in the connection.

If using HDR=Yes then you'll need to add some code to your sub to read each field name in the recordset and populate a header row on the results sheet before using CopyFromRecordSet.